recuperer les données de plusieurs fichiers

Option Explicit
Option Base 1

Sub ChercheFichiersFermesV02()
Dim Source As ADODB.Connection
Dim Rst 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
Dim Tableau() As String

Application.ScreenUpdating = False

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
        
        Set Source = New ADODB.Connection
        Source.Open "Provider = Microsoft.Jet.OLEDB.4.0;" & _
                        "data source=" & Fichier & ";" & _
                        "extended properties=""Excel 8.0;"""
                        
        texte_SQL = "SELECT Produit.NbProduit" & _
                            " FROM Produit"
                            
        Set Rst = New ADODB.Recordset
        Set Rst = Source.Execute(texte_SQL)
       
        Do While Not Rst.EOF 'boucle sur les données
        Cells(N + 5, 2) = Cells(N + 5, 2) + Rst.Fields(0).Value
        N = N + 1
        Rst.MoveNext
        Loop
       
        Rst.Close
        Source.Close
        
    End If
Next X
End If

Application.ScreenUpdating = True
End Sub