Sub CompilerPlusieursFeuillesDansUneSeule()
Dim wbk As Workbook, Ws As Worksheet, FileName$, sPath$, Source As Range
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Sélectionner le dossier source, svp."
.AllowMultiSelect = False
If .Show <> -1 Then GoTo Suite
sPath = .SelectedItems(1) & "\"
End With
'Si clic sur Annuler
Suite:
sPath = sPath
If sPath = "" Then GoTo Fin
Set Ws = ThisWorkbook.Sheets(1)
FileName = Dir(sPath & "*.xls?")
Do While Len(FileName) > 0
Set wbk = Workbooks.Open(sPath & FileName)
'recopie avec format
Set Source = wbk.Sheets(1).Range(wbk.Sheets(1).Cells(1, "A"), wbk.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Resize(, 13))
Source.Copy Ws.Cells(Rows.Count, 1).End(xlUp).Offset(1)
'recopie valeurs seules
'Set Source = wbk.Sheets(1).Range(wbk.Sheets(1).Cells(1, "A"), wbk.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Resize(, 13))
'Ws.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(Source.Rows.Count, Source.Columns.Count).Value = Source.Value
wbk.Close False
FileName = Dir
Loop
Fin:
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub