Sub fusionclasseurs()
Dim desti As Worksheet, source As Range, classeur$
Set desti = ThisWorkbook.Sheets(1)
Dossier = "C:\Tempi\"
Application.ScreenUpdating = False
classeur = Dir(Dossier & "*.xls")
Do While classeur <> ""
Workbooks.Open Dossier & "\" & classeur
With ActiveWorkbook
Set source = .Sheets(1).Range("A1").CurrentRegion.Offset(1, 0)
source.Copy desti.[A65536].End(xlUp)(2)
.Close False
End With
classeur = Dir
Loop
Set source = Nothing: Set desti = Nothing
Application.ScreenUpdating = True
End Sub