XL 2016 Macro consolidation plusieurs fichiers en 1 seul

Sub Consolidation()
'
' Objets de connexion et récupération des données
    Dim Cnx As Object, Rst As Object
    '
    ' Liste de fichier et item de fichier
    Dim Fichiers As Variant, item As Variant
    Dim ligne As Long
    '
    ' Récupérer la liste des fichiers
    Fichiers = ListeFichiers("Fichier n°*.xls?")
    '
    ' Si pas de fichiers alors prévenir et sortir
    If IsEmpty(Fichiers) Then
        MsgBox "Aucun fichier trouvé dans le répertoire", vbExclamation, "Consolidation"
        Exit Sub
    End If
 
    '
    ' Créer un object connection
    Set Cnx = CreateObject("adodb.connection")
    '
    ' Traiter chaque item de la liste
    For Each item In Fichiers
        ' Initialiser la connexion au fichier
        Cnx.connectionstring = Replace(Replace(CNX_STRING, "[DatasSource]", item), "?", "NO")
        Cnx.cursorlocation = 3
        '
        ' Ouvir la connexion
        Cnx.Open
        '
        ' création de l'objet recordset
        Set Rst = CreateObject("adodb.recordset")
        '
        ' l'ouvrir et interroger les données
        Rst.Open SQL, Cnx
        '
        ' s'il a trouvé quelque chose
        If Not Rst.BOF And Not Rst.EOF Then
            '
            ' Copier les lignes du recordset dans la prochaine ligne disponible
            ThisWorkbook.Sheets("Adodb").Cells(Rows.Count, 1).End(xlUp)(2).CopyFromRecordset Rst
            '
            ' Fermer et détruire proprement les objets adodb
            Rst.Close
            Set Rst = Nothing
        End If
        '
        ' Ne pas oublier de fermer la connexion au fichier en cours
        ' avant de passer au suivant
        Cnx.Close
    Next
    '
    ' détruire l'objet connexion
    Set Cnx = Nothing
End Sub

Function ListeFichiers(strFiltre As String) As Variant
    Dim res() As String
    Dim item As String
    Dim i As Long
    Dim Répertoire As String: Répertoire = ThisWorkbook.Path & "\"
    item = Dir(Répertoire & strFiltre)
    Do While item <> ""
        i = i + 1
        ReDim Preserve res(1 To i)
        res(i) = Répertoire & item
        item = Dir
    Loop
    ListeFichiers = IIf(i > 0, res, Empty)
End Function