Copier des feuilles de classeurs dans un fichier global

Créer une discussion
Répondre

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 !

S'inscrire
R

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
 
Trier par date Trier par votes
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+
 
Vote positif 0 Vote négatif
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
 
Vote positif 0 Vote négatif
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+
 
Vote positif 0 Vote négatif
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.
 
Vote positif 0 Vote négatif
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

Vote positif 0 Vote négatif
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+
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- 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

C
  • Question Question
Microsoft 365 Enregistrer via VBA sans ouvrir fichier
Réponses
9
Affichages
398
cdric78
C
G
  • Question Question
XL 2019 Sélectionner un fichier pour mettre à jour une base de données
Réponses
3
Affichages
311
sylvanu
sylvanu
J
  • Question Question
Microsoft 365 Copie des onglets dans un fichier séparé depuis une liste en VBA
Réponses
3
Affichages
352
job75
job75
Chaton77
  • Résolu(e)
Microsoft 365 Vba : Transférer des données d'un tableau dans un autre fichier
Réponses
7
Affichages
712
Chaton77
Chaton77
G
  • Question Question
Microsoft 365 Avoir des classeurs maitres et les procédures dans un autre classeur.
2
Réponses
19
Affichages
2 K
GClaire
G
P
  • Question Question
Microsoft 365 copier coller un onglet dans un autre fichier
Réponses
6
Affichages
638
pralo
P
X
  • Question Question
XL 2016 Copier à partir de la dernière ligne renseignée.
Réponses
8
Affichages
739
Xender
X
K
  • Résolu(e)
Microsoft 365 Ouvrir un autre classeur excel (VBA) pour utiliser les données de celui dans le classeur actif
Réponses
5
Affichages
1 K
Dranreb
Dranreb
C
  • Question Question
XL 2019 1004 sur un ActiveSheet.Paste
Réponses
5
Affichages
536
Cheyenne_2021
C
looky62
  • Question Question
Microsoft 365 VBA creation d'un export vers un fichier CSV
Réponses
12
Affichages
729
vgendron
vgendron
L
  • Résolu(e)
Microsoft 365 Pb de valeur de variable entre Sub
Réponses
5
Affichages
660
loreak
L
H
  • Résolu(e)
XL 2019 récupérer une donnée d'un fichier csv pour le copier vers un autre
2
Réponses
27
Affichages
3 K
Hutchy33
H
E
  • Question Question
XL 2019 Copier tout un tableau d'une feuille et le coller sur une autre feuille.
Réponses
1
Affichages
683
Staple1600
Staple1600
Oscar21
  • Question Question
Microsoft 365 Importer données de plusieurs classeurs dans un autre sans VBA
Réponses
7
Affichages
1 K
chris
chris
M
  • Question Question
Microsoft 365 Joindre une copie de 2 feuilles Excel dans outlook
Réponses
0
Affichages
597
Mika07
M
A
  • Question Question
Microsoft 365 Copier/coller un plusieurs lignes
Réponses
5
Affichages
825
LeSaintKebab
L
C
  • Résolu(e)
XL 2016 Remplir automatiquement un tableau d'après des conditions et des valeurs
Réponses
11
Affichages
2 K
ERIC S
ERIC S
L
  • Résolu(e)
XL 2016 VBA : Copier des valeurs entre deux fichiers
Réponses
4
Affichages
892
Leché
L
A
  • Question Question
Microsoft 365 boucle macro pour importer des données
2
Réponses
16
Affichages
2 K
Arnaud Legay
A
S
  • Résolu(e)
Microsoft 365 VBA pour copier/coller une plage de cellule dans un autre onglet en fonction de la date
Réponses
8
Affichages
1 K
Sylvain. B
S
Retour