Regrouper plusieurs fichiers excel en un seul

Bonjour,

Pour cela, il te suffit de rassembler dans un même répertoire les classeurs à regrouper, qui seront au format .xlsx (sinon modifier l'extension à l'endroit voulu dans le code), de créer un nouveau classeur au format .xlsm et d'y saisir le code suivant à exécuter:

Sub Regroupement()
Dim wbbase As Workbook, shbase As Worksheet
Dim ext As String, chemin As String
Dim fs As Object, f As Object, sf As Object
Dim wbo As Variant
Dim deli As Long, deliba As Long
 Application.ScreenUpdating = False
Set wbbase = ActiveWorkbook
Set shbase = Sheets("Recap")
chemin = wbbase.Path
ext = "xlsx"
' Extension à adapter
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(chemin)
Set sf = f.Files
For Each wbo In sf  
    If wbo.Name <> wbbase.Name And Right(wbo.Name, Len(ext)) = ext Then
        Workbooks.Open (chemin & "\" & wbo.Name)
        Sheets(1).Copy after:=wbbase.Sheets(Sheets.Count)
        deli = shbase.Cells(Rows.Count, 1).End(xlUp).Row + 1
        shbase.Cells(deli, 1).Value = wbo.Name
        shbase.Cells(deli, 2).Value = Date & " à " & Time
        Workbooks(wbo.Name).Close SaveChanges:=True
    End If
Next wbo
Set f = Nothing: Set fs = Nothing: Set sf = Nothing
shbase.Activate
Set wbbase = Nothing: Set shbase = Nothing
Application.ScreenUpdating = True

MsgBox "Les fichiers sont regroupés dans ce classeur."

End Sub

En principe, un seul classeur sera créé regroupant chacun de tes fichier par onglet.

Cdlt.