Regrouper plusieurs fichiers Excel sous un seul classeur

Bonjour,

je voudrai regrouper plusieurs fichier excel dans un seul classeur

sachant que les fichiers contiennent plusieurs feuilles

Bonjour,

... et ?

Est-ce que ça serait à faire une seule fois, comme ça ? Quelque chose de récurrent ?

Bonjour,

On peut partir d'ici pour la partie compilation.

https://www.excel-pratique.com/fr/telechargements/utilitaires/dispatcher-compiler-excel-no466

Il faudra juste itérer sur les différentes feuilles.

: joindre:

hello JoyeuxNoel !

Bonjour, jouyeuxnoel

j'ai trouvé ce que je cherché et un Grand merci quand même pour ton intension

Sub ouvreFichiers()

Dim NomFichier As Variant, Filtre As String, cmpt As Long, fich() As String

Dim wb As Workbook, nom

Filtre = "Tous les fichiers(*.xl*),*.xl*"

NomFichier = Application.GetOpenFilename(Filtre, 1, "Ouvrir", , True)

If IsArray(NomFichier) Then

Application.ScreenUpdating = False

For cmpt = LBound(NomFichier) To UBound(NomFichier)

Set wb = Workbooks.Open(NomFichier(cmpt))

With ThisWorkbook

.Activate

wb.Sheets(1).Copy After:=.Sheets(.Sheets.Count)

nom = Split(NomFichier(cmpt), "\")

.Sheets(.Sheets.Count).Name = Split(nom(UBound(nom)), ".")(0)

End With

wb.Close

Next cmpt

ThisWorkbook.Sheets(1).Activate

Application.ScreenUpdating = True

End If

End Sub

Ben, euh,... de rien

salut steelson

Tu es sûr que ton appli fonctionne sur plusieurs onglets ?

massilight a écrit :

sachant que les fichiers contiennent plusieurs feuilles

non elle me copie que le 1er onglé de chaque excel donc je modifie ThisWorkbook.Sheets(1).Activate

j'ai 4 onglé dans les 31 fichiers source mais comme c tellement urgent j'ai pas pu cherché plus je dépanne avec celle ci

ça va te faire 120 onglets dans un fichier ?

A tester ... mais j'aurais aimé avoir un exemple !

Option Explicit

Sub collecter()
Dim wbk1 As Workbook, wbk2 As Workbook
Dim MonRepertoire, Repertoire As FileDialog, monFichier$, derL%

    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire de stockage des fichiers générés"
    Repertoire.Show
    If Repertoire.SelectedItems.Count = 0 Then Exit Sub
    MonRepertoire = Repertoire.SelectedItems(1) & "\"

    Set wbk1 = ThisWorkbook
    Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Offset(1, 0).ClearContents
    monFichier = Dir(MonRepertoire & "*.xlsx")

    Do While monFichier <> ""
        Set wbk2 = Workbooks.Open(MonRepertoire & monFichier)
        For i = 1 To Worksheets.Count
            wbk1.Sheets(i).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
            derL = wbk1.Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row + 1
            wbk2.Sheets(i).Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Cells.Copy
            wbk1.Sheets(i).Paste
        Next
        Application.DisplayAlerts = False
            wbk2.Close False
        Application.DisplayAlerts = True
        Rows(derL).Delete Shift:=xlUp
        monFichier = Dir
    Loop

    Cells(Rows.Count, 1).End(xlUp).CurrentRegion.Cells(1, 1).Select

End Sub

je pars en déplacement, à ce soir si besoin