recuperation de données

Sub CommandButton1_Click()

    'merci a michelXLD et  staple 1600
    Dim connect As String
    Dim sql As String
    Dim données As ADODB.Recordset
    Dim Fichier As String, Direction As String, texte_SQL As String
    Dim X As Integer, NbFichiers As Integer, Y As Integer, N As Integer, p As Integer
    Dim Tableau() As String

    
    Direction = Dir(ThisWorkbook.Path & '\\*.xls')
    Do While Len(Direction) > 0 'liste tous les classeurs du repertoire
    NbFichiers = NbFichiers + 1
    ReDim Preserve Tableau(1 To NbFichiers)
    Tableau(NbFichiers) = Direction
    Direction = Dir()
    Loop
    
    If NbFichiers > 0 Then
    For X = 1 To NbFichiers 'boucles sur les classeurs

    ' pour ne pas prendre en compte le classeur contenant la macro (synthese)
    If Tableau(X) <> ThisWorkbook.Name Then
    
        Fichier = ActiveWorkbook.Path & '\\' & Tableau(X)
        N = 0
    
    connect = 'Provider = Microsoft.Jet.OLEDB.4.0;' & _
                        'data source=' & Fichier & ';' & _
                        'extended properties=''Excel 8.0;'''
                        
    'ici la zone a copier dans la feuille dim
    sql = 'SELECT * FROM [dim$t11:t48]'
   
    Set données = New ADODB.Recordset
    données.Open sql, connect, adOpenForwardOnly, _
                adLockReadOnly, adCmdText
    
  
    Do While Not données.EOF
    ' pour etre synchro avec les colonnes
    p = X - 1
        Cells(4, 2 + p) = Tableau(X)
        Cells(N + 5, 2 + p).CopyFromRecordset données
    N = N + 1
    Loop
            
    End If
Next X
End If

Application.ScreenUpdating = True
    
'delete de l'objet recordset
données.Close
Set données = Nothing

End Sub