1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
|
Sub CopyWorkbooks()
Dim Path As String ' Nom complet, racine comprise, du chemin des fichiers à scanner
Dim ShName As String ' Nom de la feuille source dont il faut copier les données. Doit être Identique dans tous les classeurs source
Dim SourceRangeAddress As String ' Adresse de la plage à copier. Doit être identique sur toutes les feuilles source
Dim SourceRange As Range ' sera utilisé pour définir la plage source à copier
Dim SourceWk As Workbook ' Objet qui pointera vers chaque classeur source dans la boucle
Dim TargetRange As Range ' Adresse de la première cellule de la plage d'arrivée. Sera recalculée à chaque boucle
Dim WkName As String ' Nom du classeur source à ouvrir. Sera redéfini à chaque boucle
ShName = "export" ' Nom de la feuille source qui contient les données. IDENTIQUE pour tous les classeurs source
SourceRangeAddress = "A2:G15" ' Plage à copier dans le classeur source. IDENTIQUE à chaque classeur source
Path = "D:\Users\Documents\testexport" ' Nom complet du dossier, sans \
Set TargetRange = Range("A2") ' Première plage de collage. Sera "offsetée" en fonction des données copiées à chaque boucle
WkName = Dir(Path & "\S*.xlsx") ' Nom du premier classeur trouvé dans le dossier source
Do While WkName <> "" ' Boucle tant qu'il y a un fichier non traité dans le dossier. DIR "épuise" les fichiers correspondant au pattern
Set SourceWk = Workbooks.Open(Path & "\" & WkName) 'Ouverture du fichier source et attribution du fichier à SourceWk
ThisWorkbook.Activate ' Activation du classeur de traitement (celui qui contient la macro) et, a priori, les plages d'arrivée
Set SourceRange = SourceWk.Worksheets(ShName).Range(SourceRangeAddress) ' Instanciation de la plage source
SourceRange.Copy TargetRange ' Copie de la plage source sur la plage d'arrivée, définie plus haut pas son coin supérieur gauche
Set TargetRange = TargetRange.Offset(SourceRange.Rows.Count) ' Recalcul du nouveau coin supérieur gauche pour la prochaine copie (décalage du nombre de lignes copiées)
SourceWk.Close savechanges:=False ' Fermeture du classeur d'origine sans sauvegarde
WkName = Dir() ' Recherhce du nom du classeur suivant. Si DIR est passé sur tous les classeurs, renvoie "" pour sortir de la boucle
Loop ' Boucle
End Sub |