copier toutes les feuilles d'un ensemble de fichiers Excel

Bonjour
voir ce code publié la semaine dernière sur ce forum
Sub Compilerfichiers()
'compilation de datas tirées de plusieurs classeurs à inscrire dans une seule feuille
'les unes à la suite des autres.Tu pourras l'adapter à ton besoin
Dim Temp As String, Group$
Dim Cible, Rng As Range
Dim Lrw As Long, Cf&
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Group = ActiveWorkbook.Name
Temp = Dir(ActiveWorkbook.Path & "\*.xls")
Do While Temp <> ""
Lrw = ActiveSheet.Range("A65536").End(xlUp).Row + 1
Set Cible = Feuil1.Range("A" & CStr(Lrw))
If Temp <> Group Then
Workbooks.Open ActiveWorkbook.Path & "\" & Temp
Set Rng = Workbooks(Temp).Sheets(1).Range("A1").CurrentRegion
Lrw = Feuil1.Range("A65536").End(xlUp).Row + 1
Rng.Copy Cible
Workbooks(Temp).Close
End If
Temp = Dir
Cf = Cf + 1
Set Rng = Nothing: Set Cible = Nothing
Exit Do
Loop
Application.Goto Reference:=Feuil1.Cells(2, 1), scroll:=False
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub

Cliquez pour agrandir...

flyonets44 à dit:

Cordialement
Flyonets

Cliquez pour agrandir...