XL 2010 [Résolu] Copier les données(feuilles-classeur source) vers classeur de destination.

Lone-wolf

XLDnaute Barbatruc
Bonjour le Forum :)

Dans le fichier joint, j'ai un souci avec la macro, qui normalement, devrait masquer les colonnes vides de chaque feuille du classeur source, puis copier les données dans le classeur de destination.
 

Fichiers joints

youky(BJ)

XLDnaute Barbatruc
Hello,
truc pas bon
For k = 9 To 1 Step -1
derlig = .Sheets(i).Cells(Rows.Count, k).End(xlUp).Row
Next k
faut pas faire de boucle k supprime le for k et le next (cela sert à rien)
je regarde la suite
 

youky(BJ)

XLDnaute Barbatruc
Yes,
Je n'ai pas testé et suis pas sur de ce que tu attends
Voici un nouveau code
Bruno
VB:
Sub Import_Data()
Dim derlig As Long, col As Long, i As Long, dercol As Long
    Application.ScreenUpdating = False
    Fichier = ThisWorkbook.Path & "\Source\Data.xls"
Workbooks.Open (Fichier)
    Set WbData = Workbooks("Data.xls")
    Set Sh = ThisWorkbook.Sheets(1)
With WbData
  For i = 2 To .Sheets.Count
    dercol = .Sheets(i).Columns("I").Find("", , , , , xlPrevious).Column
       For col = dercol To 1 Step -1
        If Application.CountA(.Sheets(i).Columns(col)) = 1 Then
          .Sheets(i).Columns(col).Hidden = True
          .Cells.SpecialCells(12).Copy Sh.Range("A" & Sh.[A65000].End(3).Row + 1)
        End If
       Next col
  Next i
End With
WbData.Close savechanges:=False
'ActiveWorkbook.Close False
End Sub
 

Paf

XLDnaute Barbatruc
Bonjour Lone-wolf, youky(BJ),

un essai si j'ai tout compris:

VB:
Sub Import_Data()
Dim derlig As Long, lig As Long, col As Long, i As Long, dercol As Long, Plage As Range

    Application.ScreenUpdating = False

    Fichier = ThisWorkbook.Path & "\Source\Data.xls"
    Set Sh = ThisWorkbook.Sheets(1)
    Set WbData = Workbooks.Open(Fichier)
    With WbData
        For i = 2 To .Sheets.Count
            dercol = .Sheets(i).Cells(1, Columns.Count).End(xlToLeft).Column
            Set Plage = .Sheets(i).Range("A1").CurrentRegion
            For col = dercol To 1 Step -1
                If WorksheetFunction.CountA(Plage.Columns(col)) = 1 Then ' s'il n'y a que le titre
                    Plage.Columns(col).EntireColumn.Hidden = True
                End If
            Next
            derlig = Sh.Range("A" & Rows.Count).End(xlUp).Row + 1
            Plage.SpecialCells(12).Copy Sh.Range("A" & derlig)
        Next i
        .Close False
    End With
    Application.ScreenUpdating = True

End Sub
A+


Edit : J'aurai dû rafraîchir ! désolé youky!

Dans la mesure ou on masque des colonnes , on va copier à la suite, des données qui n'ont pas les mêmes entêtes de colonnes ?!?!
 

youky(BJ)

XLDnaute Barbatruc
Bonjour Paf,
Je me suis posé exactement la même question ! ! hihi
Nos macros sont un peu similaire . . . et font idem
Bruno
 

Lone-wolf

XLDnaute Barbatruc
Bonsoir Paf :), Bruno

Bruno, j'ai une erreur sur la ligne: .Cells.SpecialCells(12).Copy Sh.Range("A" & Sh.[A65000].End(3).Row + 1)

erreur.gif



Paf, en image ce que donne ta macro

resultat.gif

Et il y a encore un autre tableau qui viens à la suite.
 
Dernière édition:

youky(BJ)

XLDnaute Barbatruc
Hello,
J'avais oublié (mis en gras)
.Sheets(i).Cells.SpecialCells(12).Copy Sh.Range("A" & Sh.[A65000].End(3).Row + 1)
je pense que le résultat sera idem que Paf
Je suis satisfait d'avoir eu le même raisonnement que Paf, si c'est pas ce que tu attends il fautnous rectifier le tir.
Bruno
 

Lone-wolf

XLDnaute Barbatruc
Rebonsoir tout le monde :)

J'ai changé comme ceci

VB:
Sub Import_Data()
Dim derlig As Long, col As Long, i As Long, dercol As Long
    Application.ScreenUpdating = False
    Fichier = ThisWorkbook.Path & "\Source\Data.xls"
    Workbooks.Open (Fichier)
    Set WbData = Workbooks("Data.xls")
    Set Sh = ThisWorkbook.Sheets(1)
    With WbData
        For i = 2 To .Sheets.Count
            dercol = .Sheets(i).Columns("I").Find("", , , , , xlPrevious).Column
            On Error Resume Next
            For col = 1 To dercol 'To 1 Step -1
                If .Sheets(i).Columns(col).Text = "" Then
                    .Sheets(i).Columns(col).Hidden = True
                End If
            Next col
            .Sheets(i).Cells.SpecialCells(12).Copy Sh.Range("a1")
        Next i
    End With
     ActiveWorkbook.Save
    ActiveWorkbook.Close True
End Sub
La macro fonctionne, seulement il y a un autre problème. Les colonnes vides de la dernières feuille ne sont pas prises en considérations, ce qui est bizarre. Vue que c'est celle-ci qui est selectionnée en dernier, je me retrouve avec les colonnes Quantité et Remise vides.

Edit: C'est bizarre, si je masque manuellement les colonnes de la dernière feuille, j'ai l'impression quelle copie juste la dernière feuille, puisque je n'ai pas Commande n° et Date de commande.
 
Dernière édition:

Paf

XLDnaute Barbatruc
re tous et bonjour job75,


A regarder le dernier classeur joint, on veut simplement compléter la feuille 5 du classeur source avec les colonnes D et F de la feuille 3 et copier le résultat en classeur cible ... (?) ( c'est ce que fait la macro)

Je ne comprends pas l'intérêt de boucler sur toutes les feuilles du classeur source pour
- en masquer les colonnes vides
- copier chaque fois les colonnes D et F de la feuille 3 sur les colonnes D et F de la feuille 5
- copier les cellules visibles de chaque feuille en A1 du classeur cible (pour au final obtenir la copie de la dernière feuille du classeur source)

A+
 

Lone-wolf

XLDnaute Barbatruc
Bonsoir Paf, le Forum :)

Pour mieux comprendre ce que j'ait fait, supprime les lignes de Det F ensuite lance la macro. ;) Teste aussi la macro de Bruno.

Le principe est du style suivant: dans un formulaire avec une combobx et 3 Listbox ou ListeView. On fait une recherche avec la combo.

Dans la première listbox, on affiche le numéro de commande et la date de commande.
Dans la deuxième: article, quantité, rabais et prix
Dans la troisième: le nom du client, le montant de la facture et la date de paiement.

Tu vois où je veux en venir? ;)
 
Dernière édition:

Discussions similaires


Haut Bas