Copier/coller X onglets de X fichiers sur un seul fichier

Bonjour à tous,

Je m'arrache les cheveux depuis 2 jours (en cette période de confinement, d'un côté, ce n'est pas plus mal... ) pour essayer de trouver une solution à mon problème. Je ne connais pas le langage VBA, dès que j'ai besoin, je vais fouiner sur le net et à chaque fois je trouve une solution...mais pas cette fois-ci.

Alors voilà, je vais avoir dans un dossier (disons qu'il sera dans mes documents, dans un sous-dossier "RETOUR" présent dans le dossier "CAT") 27 fichiers (avec des noms différents) et dans chacun d'eux, de 1 à 7 onglets avec des noms différents également.

Mon but serait de copier/coller vers un fichier s'appelant "RECAP RETOURS" sur un seul onglet "RECUPERATION FICHES", le contenu de chacun des onglets présents dans chaque fichier, les uns en dessous des autres. Au total, il devrait y avoir une soixantaine d'onglet à copier/coller.

Mon fichier "RECAP RETOURS" sera dans le même dossier que les fichiers sources. Le nom des services dans les fichiers joints a été anonymisé, en aucun cas le nom des fichiers se suivra de cette façon. Le nombre de lignes des fichiers sources peut également varier, en revanche, le nombre de colonne est toujours identique.

J'aurais besoin de votre aide

Je vous adresse un exemple avec 4 fichiers

Merci à vous

Bonjour Ptivoyou, bonjour le forum,

Ce code, à placer dans le fichier RECAP RETOURS, devrait fonctionner (non testé) :

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim EF As Object 'déclare la variable EX (Explorateur de Fichiers)
Dim DI As Object 'déclare la variable DI (Dossier Initial)
Dim FS As Object 'déclare la variable FS (FichierS)
Dim F As Object 'déclare la variable F (Fichier)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets("RECUPERATION FICHES") 'définit l'onglet destination OD
Set EF = CreateObject("Scripting.FileSystemObject") 'définit l'explorateur de fichiers EF
Set DI = EF.GETFolder(CD.Path) 'définit le dossier initial DI
Set FS = DI.Files 'définit l'ensemble des fichiers FS du dossier initial DI
For Each F In FS 'boucle 1 : sur tous les fichiers F de FS
    Set CS = Application.Workbooks.Open(F) 'définit le classeur source CS en l'ouvrant
    For Each OS In CS.Worksheets 'boucle 2 : sur tous les onglets OS du classeur source
        'définit la cellule de destination DEST (A1, si A1 est vide, sinon la première cellule vide de la colonne A de l'onglet OD)
        Set DEST = IIf(OD.Range("A1") = "", OD.Range("A1"), OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0))
        OS.UsedRange.Copy DEST 'copy la plage éditée de l'onglet source et la colle dans DEST
    Next OS 'prochaine onglet de la boucle 2
    CS.Close False 'ferme le classeur source sans enregistrer
Next F 'prochain fichier de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

ThauThème,

je te remercie, mais cela ne fonctionne pas. Lorsque je lance la macro, j'ai un premier message me signalant que le fichier de destination est déjà ouvert. Si je clique sur non, la macro se poursuit jusqu'au message d'erreur 400. Au final, je ne récupère que le dernier onglet "MNO" du service 3...

Re,

Evidemment ! J'suis bête...

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim EF As Object 'déclare la variable EX (Explorateur de Fichiers)
Dim DI As Object 'déclare la variable DI (Dossier Initial)
Dim FS As Object 'déclare la variable FS (FichierS)
Dim F As Object 'déclare la variable F (Fichier)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets("RECUPERATION FICHES") 'définit l'onglet destination OD
Set EF = CreateObject("Scripting.FileSystemObject") 'définit l'explorateur de fichiers EF
Set DI = EF.GETFolder(CD.Path) 'définit le dossier initial DI
Set FS = DI.Files 'définit l'ensemble des fichiers FS du dossier initial DI
For Each F In FS 'boucle 1 : sur tous les fichiers F de FS
    If F.Name <> CD.Name Then 'condition : si le fichier n'est pas le fichier destination
        Set CS = Application.Workbooks.Open(F) 'définit le classeur source CS en l'ouvrant
        For Each OS In CS.Worksheets 'boucle 2 : sur tous les onglets OS du classeur source
            'définit la cellule de destination DEST (A1, si A1 est vide, sinon la première cellule vide de la colonne A de l'onglet OD)
            Set DEST = IIf(OD.Range("A1") = "", OD.Range("A1"), OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0))
            OS.UsedRange.Copy DEST 'copy la plage éditée de l'onglet source et la colle dans DEST
        Next OS 'prochaine onglet de la boucle 2
        CS.Close False 'ferme le classeur source sans enregistrer
    End If 'fin de la condition
Next F 'prochain fichier de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

Bonjour,

Je n'ai peut etre pas ta solution mais j'ai un fichier qui m'avait ete donné concernant ta demande ( du moins ca se rapproche )

regarde si ca te plait.

c'est pour mettre X fichier dans un seul fichier ( il suffit de selectionné le dossioer ou se situe tes fichier )

ThauThème,

l'erreur 400 s'affiche toujours, et je récupère seulement l'onglet MNO du fichier 3...

Bonjour le fil, bonjour le forum,

@ Jerome : Oui la méthode avec DIR que j'utilise aussi. Mais comme j'avais répondu sur un autre fil avec le méthode Explorateur de fichiers, j'ai fait un copier/coller.

@ Ptivoyou : bon, je vais tester chez moi...

Re,

Pourrais-tu m expliquer comment supprimer le panneau Informations sur le document ? Je le ferme mais il se ré affiche sans cesse...

@jeromechant : merci, ça avance, le hic que je rencontre c'est que je ne sais pas comment désigner l'ensemble des onglets de chaque fichier. J'ai bidouiller un peu le code pour supprimer justement la box demandant le nom de l'onglet, mais je me retrouve cette fois-ci avec le premier onglet de chaque fichier

@ThauThème, c'est une très bonne question, tous nos fichiers au boulot sont comme ça, et pour être honnête, je ne sais pas comment faire...

@ ThauThème, le problème rencontré ne provient-il pas du fait que la macro sélectionne sans cesse la cellule A1 comme destination ?

Re,

Bon, tableaux bien m***eux à souhait pour du VBA. Heureusement qu'un petit malin chez vous a eu la lumineuse d'écrire DEBUT (en blanc sur fond blanc) sur la dernière cellule du tableau. Quant au panneau d'Information, je suis persuadé que c'est lui qui génère l'erreur. J' ai pas la solution mais j'ai contourné...

Le code :

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim EF As Object 'déclare la variable EX (Explorateur de Fichiers)
Dim DI As Object 'déclare la variable DI (Dossier Initial)
Dim FS As Object 'déclare la variable FS (FichierS)
Dim F As Object 'déclare la variable F (Fichier)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim LF As Integer
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets("RECUPERATION FICHES") 'définit l'onglet destination OD
OD.Rows.Hidden = False
OD.Cells.Clear
Set EF = CreateObject("Scripting.FileSystemObject") 'définit l'explorateur de fichiers EF
Set DI = EF.GETFolder(CD.Path) 'définit le dossier initial DI
Set FS = DI.Files 'définit l'ensemble des fichiers FS du dossier initial DI
For Each F In FS 'boucle 1 : sur tous les fichiers F de FS
    On Error Resume Next
    If F.Name <> CD.Name Then 'condition : si le fichier n'est pas le fichier destination
        Set CS = Application.Workbooks.Open(F) 'définit le classeur source CS en l'ouvrant
        If Err <> 0 Then
            Err.Clear
            Exit Sub
        End If
        On Error GoTo 0
        For Each OS In CS.Worksheets 'boucle 2 : sur tous les onglets OS du classeur source
            OS.Rows.Hidden = False
            LF = OS.Columns(1).Find("DEBUT", , xlValues, xlWhole).Row - 1
            Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp) 'définit la cellule de destination DEST
            OS.Range(OS.Cells(1, "A"), OS.Cells(LF, "Q")).Copy DEST
        Next OS 'prochaine onglet de la boucle 2
        CS.Close False 'ferme le classeur source sans enregistrer
    End If 'fin de la condition
Next F 'prochain fichier de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

Ne me demande plus rien sur ce fichier. Si ça ne marche pas je passe la main...

@ThauTheme : pour le mot "début", le petit malin c'est moi, car l'ensemble des fichiers que je vais devoir traiter sont en fait issus d'un seul onglet que j'ai construis et que j'obtiens avec une macro qui défile sur l'ensemble des choix possible. Pour obtenir ce que je voulais en terme d'affichage, je n'ai pas eu d'autre choix que d'intégrer un "début" variable sur mon fichier source.

Au-delà de cet élément, je te remercie car ta macro fonctionne, j'obtiens exactement ce que je souhaite avoir.

Merci +++ de ton aide précieuse.

Re,

C'était un très bon DEBUT... . En tous cas c'est ce qui m'a permis de faire la macro, après quelques arrachage de cheveux (enfin de ce qu'il en reste)...