Bonjour Ansi19 et bienvenue sur ce forum,
à tester,
il faut activer la référence: Microsoft ActiveX Data Objects xx Library --> au menu vba, Outils, Référence
Sub Read_File()
Dim Repertoire As String, Fichier As String, Fich As String, NomFeuille As String
Dim Ligne As Long, f, colonne, col As Integer, addr As String
Dim fso As Object, sfofolder As Object, oFile As Object
Dim Cnn As Object, Rst As ADODB.Recordset
Ligne = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row + 1
Repertoire = ThisWorkbook.Path
NomFeuille = "Feuil1" 'à adapter
Set fso = CreateObject("Scripting.FileSystemObject")
Set sfofolder = fso.GetFolder(Repertoire)
For Each oFile In sfofolder.Files
'--- lire uniquement les fichiers qui ont un extention "xlsx"---
If Right(Fich, 4) = "xlsx" Then 'à adapter
Set Cnn = New ADODB.Connection
'--- Connexion ---
With Cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
& oFile & ";Extended Properties=""Excel 12.0;HDR=NO;"""
.Open
End With
colonne = Array(1, 2, 3, 4, 7, 12, 14)
For i = LBound(colonne) To UBound(colonne)
addr = Columns(colonne(i)).Address(0, 0)
Set Rst = Cnn.Execute("SELECT * FROM [" & NomFeuille & "$" & addr & "]")
Cells(Ligne, "A") = Fich
col = Cells(Ligne, Columns.Count).End(xlToLeft).Column + 1
Cells(Ligne, col).CopyFromRecordset Rst
Rst.Close
Set Rst = Nothing
Next i
Ligne = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row + 1
End If
Next oFile
Cnn.Close
Set Cnn = Nothing
End Sub