Fusionner plusieurs fichiers excel

Option Explicit
Option Private Module
'

Public Sub Synthèse_Classeurs_AE()
Dim wbk As Workbook                'Classeur
Dim Système As Object              'Système de fichiers
Dim Dossier As Object              'Répertoire
Dim Fichiers As Object             'Collection de fichiers du répertoire Dossier
Dim Fichier As Object              'Fichier (élément de la collection Fichiers)
Dim Nom_Fichier As String          'Nom du fichier
Dim Nom_Dossier As String          'Nom du dossier

'Répertoire des fichiers AE
Nom_Dossier = ThisWorkbook.Path & "/AE"

'Lecture du répertoire
Set Système = CreateObject("Scripting.FileSystemObject")
Set Dossier = Système.GetFolder(Nom_Dossier)
Set Fichiers = Dossier.Files
'- Contrôle de chaque le fichier du répertoire
For Each Fichier In Fichiers
  '- Vérifier s'il s'agit d'un fichier Excel...
  If StrComp(Système.GetExtensionName(Fichier.name), "xls", vbTextCompare) = 0 Then
    '... dans l'affirmative, ouvrir le fichier et mettre à jour les liaisons
    Nom_Fichier = Nom_Dossier & "\" & Fichier.name
    Set wbk = Workbooks.Open(Filename:=Nom_Fichier, UpdateLinks:=xlUpdateLinksNever)
    Call Ajouter_Données_AE(wbk)
    wbk.Close SaveChanges:=False
  End If
Next Fichier
  
End Sub

Public Sub Ajouter_Données_AE(wbk As Workbook)
Dim celOrg As Range
Dim celDst As Range

'Première info de AE
Set celOrg = wbk.Worksheets(1).Range("A20")

'Dernière cellule utilisée de la première colonne du fichier retour
Set celDst = ThisWorkbook.Worksheets(1).Cells(ThisWorkbook.Worksheets(1).Rows.Count, 1).End(xlUp)

'Copie des données
Do While celOrg.Formula <> ""
  Set celDst = celDst.Offset(1)
  'Corps d'état
  celDst.Value = celOrg.Value
  'Entreprise
  celDst.Offset(, 1).Value = celOrg.Offset(, 1).Value
  'Nombre d'opérations
  '- je ne sais pas d'ou vient cette info
  'Note
  celDst.Offset(, 3).Value = celOrg.Offset(, 5).Value
  'suivant
  Set celOrg = celOrg.Offset(1)
Loop

End Sub

Private Sub CommandButton1_Click() 
  Call Synthèse_Classeurs_AE 
End Sub