Bonjour,
J’ai un dossier qui contient une centaine de fichiers identiques (recueil 01.xls, recueil 02.xls, etc)
La macro ci-dessous copie une plage de chaque fichier et les colle dans un classeur de destination nommé recueil .xls en recherchant à chaque fois la première cellule vide.
Cette macro se trouve dans un autre classeur utilisé uniquement pour cette opération.
Bien que tout cela fonctionne, je cherche à alléger ce code par une boucle, afin de ne pas avoir à recopier ce code pour chaque département, mais je ne sais comment faire.
Merci pour votre aide
Romain
Sub Rassemble()
'Cette macro sélectionne chaque fichier et les colle
'les uns à la suite des autres dans un nouveau fichier (sans modifier les fichiers sources)
'Elle recherche la première cellule vide en colonne C et vient se positionner en
'colonne B pour effectuer la copie
'Ignorer les messages d'alerte
Application.DisplayAlerts = False
'Vide le fichier RECUEIL.XLS et l'enregistre
Workbooks.Open FileName:="C:\RECUEIL\RECUEIL.XLS"
Sheets("Global").Select
Range("B5😛10000").Select
Selection.Clear
ActiveWorkbook.Save
'TRAITEMENT DU DEPARTEMENT 01
'Ouverture du premier département, sélection et copie
Workbooks.Open FileName:="C:\RECUEIL\Recueil 01.xls"
Sheets("Fiche_recueil").Select
Range("B84😛500").Select
Selection.Copy
'Ouverture du fichier destination et copie du premier département en plage A2
Windows("RECUEIL.xls").Activate
Range("B5").Select
'Copie des valeurs seules - collage spécial
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
'Evite le message de conserver les données dans le presse-papiers
Application.CutCopyMode = False
'Fermeture du premier département sans enregistrer les modifications
Windows("Recueil 01.xls").Activate
ActiveWorkbook.Close
'==========================================================================
'TRAITEMENT DU DEPARTEMENT 02
Workbooks.Open FileName:="C:\RECUEIL\Recueil 02.xls"
Sheets("Fiche_recueil").Select
Range("B84😛500").Select
Selection.Copy
'Activation du fichier de destination
Windows("RECUEIL.XLS").Activate
'Recherche la première cellule vide
Columns("c").Find("").Activate
'Se positionne en colonne B
Cells.FindPrevious(After:=ActiveCell).Activate
ActiveCell.Select
ActiveSheet.Paste
'Evite le message de conserver les données dans le presse-papiers
Application.CutCopyMode = False
'Fermeture du fichier départemental
Windows("Recueil 02.xls").Activate
ActiveWorkbook.Close
'==========================================================================
'TRAITEMENT DES AUTRES DEPARTEMENTS…
'==========================================================================
End Sub
J’ai un dossier qui contient une centaine de fichiers identiques (recueil 01.xls, recueil 02.xls, etc)
La macro ci-dessous copie une plage de chaque fichier et les colle dans un classeur de destination nommé recueil .xls en recherchant à chaque fois la première cellule vide.
Cette macro se trouve dans un autre classeur utilisé uniquement pour cette opération.
Bien que tout cela fonctionne, je cherche à alléger ce code par une boucle, afin de ne pas avoir à recopier ce code pour chaque département, mais je ne sais comment faire.
Merci pour votre aide
Romain
Sub Rassemble()
'Cette macro sélectionne chaque fichier et les colle
'les uns à la suite des autres dans un nouveau fichier (sans modifier les fichiers sources)
'Elle recherche la première cellule vide en colonne C et vient se positionner en
'colonne B pour effectuer la copie
'Ignorer les messages d'alerte
Application.DisplayAlerts = False
'Vide le fichier RECUEIL.XLS et l'enregistre
Workbooks.Open FileName:="C:\RECUEIL\RECUEIL.XLS"
Sheets("Global").Select
Range("B5😛10000").Select
Selection.Clear
ActiveWorkbook.Save
'TRAITEMENT DU DEPARTEMENT 01
'Ouverture du premier département, sélection et copie
Workbooks.Open FileName:="C:\RECUEIL\Recueil 01.xls"
Sheets("Fiche_recueil").Select
Range("B84😛500").Select
Selection.Copy
'Ouverture du fichier destination et copie du premier département en plage A2
Windows("RECUEIL.xls").Activate
Range("B5").Select
'Copie des valeurs seules - collage spécial
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
'Evite le message de conserver les données dans le presse-papiers
Application.CutCopyMode = False
'Fermeture du premier département sans enregistrer les modifications
Windows("Recueil 01.xls").Activate
ActiveWorkbook.Close
'==========================================================================
'TRAITEMENT DU DEPARTEMENT 02
Workbooks.Open FileName:="C:\RECUEIL\Recueil 02.xls"
Sheets("Fiche_recueil").Select
Range("B84😛500").Select
Selection.Copy
'Activation du fichier de destination
Windows("RECUEIL.XLS").Activate
'Recherche la première cellule vide
Columns("c").Find("").Activate
'Se positionne en colonne B
Cells.FindPrevious(After:=ActiveCell).Activate
ActiveCell.Select
ActiveSheet.Paste
'Evite le message de conserver les données dans le presse-papiers
Application.CutCopyMode = False
'Fermeture du fichier départemental
Windows("Recueil 02.xls").Activate
ActiveWorkbook.Close
'==========================================================================
'TRAITEMENT DES AUTRES DEPARTEMENTS…
'==========================================================================
End Sub