Comment transférer des données d'un classeur à un autre?
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
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 Subj'ai également un autre code mais sans succès
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 SubSi vous pouvez m'aider je vous remercie par avance, bonne soirée
Bonsoir
Essayes cette macro
Filtre les fichiers qui commencent par "Fichier "
Récupère les données de la colonne A qu'elle recopie en ligne
Attention le nom de la page s'appelle "Feuil1", adapte suivant ton fichier
Option Explicit
Sub transfert()
Dim Fichier As String, Chemin As String
Dim DerLig As Long
Dim Wks As Worksheet
Application.ScreenUpdating = False
Set Wks = ThisWorkbook.Sheets("Feuil1") 'fichier excel ouvert qui va récupérer les données
Chemin = "C:\Bibliothèque\Document\test macro\"
DerLig = 2
Fichier = Dir(Chemin & "Fichier *.xls")
Do While Fichier <> ""
With Workbooks.Open(Chemin & Fichier)
With .Sheets("Harnais")
.Range("A7:A" & .Range("A" & Rows.Count).End(xlUp).Row).Copy
End With
Wks.Range("A" & DerLig).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
DerLig = DerLig + 1
.Close
End With
Fichier = Dir
Loop
Set Wks = Nothing
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "Terminé"
End Sub