eglantine217 | Bonjour, je galère bcp avec plusieurs codes que j'ai essayé de faire et je n'arrive tj pas à résoudre mon pb. Le but est d’avoir un fichier Excel nommé « classeur1 » qui récupère toutes les données de plusieurs fichiers excel présents dans un répertoire qui stocke ces fichiers excel (fichier 1 puis 2 puis 3 et 4 ...), le chemin d’accès est connu, la macro doit ouvrir un par un ces fichiers et coller les données de la colonne A du fichier 1 dans le classeur 1 destiné à la récupération de l’ensemble des données. Exemple : classeur1 ouvert Clique sur la macro qui ... Ouvre le fichier 1 excel copie la colonne A et la colle en ligne dans la ligne A1 du fichier Classeur1 Puis fermeture du fichier 1 Ouverture du fichier 2 copie la colonne A et la colle en ligne A2 du fichier Classeur1 puis ferme le fichier 2 et ainsi desuite
Code :
- Sub transfert()
- Dim fichier As String
- Dim chemin As String
- Dim derlig As Long
- Dim Xks As Worksheet
- Dim lifin As String
- Set wks = ThisWorkbook.Sheets("Feuil" ) 'fichier excel ouvert qui va récupérer les données
- chemin = "C:\Bibliothèque\Document\test macro\"
- derlig = 2
- fichier = Dir(chemin & "*.xls" )
- Do While fichier <> ""
- Workbooks.Open (chemin & fichier)
- derlig = Range("A7:A" & Rows.Count).End(xlUp).Row
- lifin = Range("A" & Rows.Count).End(xlUp).Row
- With Sheets("Harnais" ).Range("A7:A" & lifin).Copy
- End With
- wks.Range("A" & derlig).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
- SkipBlanks:=False, Transpose:=False
- derlig = derlig + 1
- ActiveWorkbook.Close
- fichier = Dir
- Loop
- Set wks = Nothing
- End Sub
|
j'ai également un autre code mais sans succès
Code :
- Sub test()
- Dim fichier As String, chemin As String
- Dim wb As Workbook
- chemin = "C:\Bibliothèque\Documents\test macro\"
- fichier = Dir(chemin & "*.xls" )
- Do While fichier <> ""
- Set wb = Workbooks.Open(chemin & fichier)
- Const FO = "Onglet1"
- Const FD = "Feuil1"
- Dim lifin As Long
- Set FDest = ThisWorkbook
- Set FPrem = Workbooks.Open(chemin & fichier)
- lifin = Range("A" & Rows.Count).End(xlUp).Row
- Workbooks("Classeur1.xls" ).Sheets(FD).Ra… (Cells(lig, 1)), (Cells(lig, 1)) = Application.Transpose.Workbook(FPrem).Sh… & lifin)
- FPrem.Close True
- Set wb = Nothing
- fichier = Dir
- Loop
- End Sub
|
merci bcp, bonne soirée |