Copier des feuilles de classeurs dans un fichier global

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Romain31

XLDnaute Occasionnel
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
 
Re : Copier des feuilles de classeurs dans un fichier global

bonjour Romain31,

voici un essai (ja n'ai pas testé le code) :
Code:
Sub test()
Dim wbkGlobal As Workbook, wbkDepartement As Workbook, listeClasseursDepartement, i As Integer, cellulePaste As Range

'définir la liste des "classeurs département"
listeClasseursDepartement = Array("C:\RECUEIL\Recueil 01.xls", "C:\RECUEIL\Recueil 02.xls", "C:\RECUEIL\Recueil 03.xls")

Set wbkGlobal = Application.Workbooks.Open("C:\RECUEIL\RECUEIL.XLS")
'vider les données de la feuille "Global"
wbkGlobal.Sheets("Global").Cells.Clear

For i = LBound(listeClasseursDepartement) To UBound(listeClasseursDepartement)
    'boucler sur chaque "classeur département"
    Set wbkDepartement = Application.Workbooks.Open(listeClasseursDepartement(i), , True)
    
    'récupérer la première cellule vide de la feuille "Global"
    With wbkGlobal.Sheets("Global")
        Set cellulePaste = .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0)
    End With
    
    'copier la zone du "classeur département" vers la cellule définie plus haut
    wbkDepartement.Sheets("Fiche_recueil").Range("B84:P500").Copy cellulePaste

    wbkDepartement.Close False
Next i
End Sub
a+
 
Re : Copier des feuilles de classeurs dans un fichier global

Déjà un grand merci pour ta réponse.

Malheureusement, je ne récupère que le premier département.
Je me demandais également si je devais lister dans le code tous les départements
- 'définir la liste des "classeurs département"
listeClasseursDepartement = Array("C:\RECUEIL\Recueil 01.xls", "C:\RECUEIL\Recueil -
Comme tu l'as indiqué.

Ne pourrait t-on pas faire quelque chose du style : pour chaque département trouvé, rechercher la cellule vide, copier la plage, etc
 
Re : Copier des feuilles de classeurs dans un fichier global

re bonjour,

une autre solution (toujours pas testée) :
Code:
Sub test()
Dim wbkGlobal As Workbook, wbkDepartement As Workbook, i As Integer, cellulePaste As Range
Dim dossier As Object, fichier As Object

Set dossier = CreateObject("Scripting.FileSystemObject").GetFolder("C:\RECUEIL")

Set wbkGlobal = Application.Workbooks.Open("C:\RECUEIL\RECUEIL.XLS")
'vider les données de la feuille "Global"
wbkGlobal.Sheets("Global").Cells.Clear

'boucler sur chaque fichier du dossier
For Each fichier In dossier.Files
    'vérifier qu'il s'agit d'un classeur commançant par "Recueil "
    If fichier.Name Like "Recueil *" Then
        Set wbkDepartement = Application.Workbooks.Open(fichier.Path, , True)
        
        'récupérer la première cellule vide de la feuille "Global"
        With wbkGlobal.Sheets("Global")
            Set cellulePaste = .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0)
        End With
        
        'copier la zone du "classeur département" vers la cellule définie plus haut
        wbkDepartement.Sheets("Fiche_recueil").Range("B84:P500").Copy cellulePaste
    
        wbkDepartement.Close False
    End If
Next fichier

End Sub

a+
 
Re : Copier des feuilles de classeurs dans un fichier global

Apparemment cela boucle mais je ne copie que le premier département.

Je m'aperçois que je n'arrive pas sur le bon onglet du département 2.
J'ai rajouté :
wbkDepartement.Sheets("Fiche_recueil").Select

Malheureusement, sans amélioration.
Par contre, le code de mon message d'origine en haut de cette page fonctionne parfaitement. En fait j'ai un problème de boucle mais je ne suis pas très fort la dessus.
 
Re : Copier des feuilles de classeurs dans un fichier global

Voici un fichier zip contenant les fichiers
C:\recueil\rassemble.xls lance la macro
3 fichiers test sont dans ce dossier
Recueil.xls récupère les plages de données des 3 fichiers

Cela fonctionne mais je veux alléger le code et ne pas nommer les départements pour récupérer les données

Je viens de voir un autre fil dans le même genre où Catrice propose un exemple qui ressemble fort à ce que je cherche à faire.

Merci à tous ceux qui m'aideront
 

Pièces jointes

Re : Copier des feuilles de classeurs dans un fichier global

re bonjour,

c'est bien plus simple avec des fichiers exemple 😉
voici la macro modifiée :
Code:
Sub Rassemble()
Dim wbkGlobal As Workbook, wbkDepartement As Workbook, i As Integer, cellulePaste As Range
Dim dossier As Object, fichier As Object

Set dossier = CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path)

Set wbkGlobal = Application.Workbooks.Open(ThisWorkbook.Path & "\RECUEIL.XLS")

'boucler sur chaque fichier du dossier
For Each fichier In dossier.Files
    'vérifier qu'il s'agit d'un classeur commançant par "Recueil "
    If fichier.Name Like "Recueil *" Then
        Set wbkDepartement = Application.Workbooks.Open(fichier.Path, , True)
        
        'récupérer la première cellule vide de la feuille "Global"
        With wbkGlobal.Sheets("Global")
            Set cellulePaste = .Range("B" & .Rows.Count).End(xlUp).Offset(1, 0)
        End With
        
        'copier la zone du "classeur département" vers la cellule définie plus haut
        wbkDepartement.Sheets("Fiche_recueil").Range("B1:P500").Copy cellulePaste
    
        wbkDepartement.Close False
    End If
Next fichier

End Sub

j'ai extrait ton fichier zip, modifié la macro de ton fichier rassemble.xls et ça a l'air de fonctionner.


a+
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
813
Retour