Sub ParcoursFichiers()
Dim FD As FileDialog, FS As FileSearch, Chemin As String
Dim Wkb As Workbook
Set FD = Application.FileDialog(msoFileDialogFolderPicker)
FD.AllowMultiSelect = False
FD.Title = "Choix du dossier"
FD.InitialView = msoFileDialogViewList
FD.InitialFileName = "C:\"
If FD.Show <> 0 Then
Chemin = FD.SelectedItems(1)
End If
ThisWorkbook.ActiveSheet.Range("A2:B65536").ClearContents
Set FS = Application.FileSearch
With FS
.NewSearch
.LookIn = Chemin
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Set Wkb = Workbooks.Open(.FoundFiles(i))
Wkb.Worksheets("Feuil1").Activate
Wkb.Worksheets("Feuil1").Range("A2:C" & ActiveSheet.Range("C65536").End(xlUp).Row).Copy
ThisWorkbook.ActiveSheet.Paste Destination:=ThisWorkbook.ActiveSheet.Range("a65536").End(xlUp).Offset(1, 0)
Wkb.Close False
Next i
End If
End With
End Sub