Regrouper plusieurs classeurs excel en Un

Option Explicit

Sub CompilationClasseurs()
Dim Repertoire As String, Fichier As String
Dim Wb As Workbook
Dim Ws As Worksheet
Dim x As Integer
Dim classeur1 As String

Repertoire = ThisWorkbook.Path & "\"
classeur1 = ActiveWorkbook.Name
'Repertoire = "C:\dossier"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Fichier = Dir(Repertoire & "\classeurx*.xls")

Do While Fichier <> ""


Set Wb = Workbooks.Open(Repertoire & "\" & Fichier)
x = Workbooks(classeur1).Sheets(1).Range("A65536").End(xlUp).Row + 1

Set Ws = Wb.Sheets(1)
Ws.Range("A1:i2000").Copy _
Destination:=Workbooks(classeur1).Sheets(1).Range("a" & x)

Wb.Close False

Fichier = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Opération terminée."
End Sub

variante pour obtenir uniquement les valeurs


.....................................................
Do While Fichier <> ""
Set Wb = Workbooks.Open(Repertoire & "\" & Fichier)
x = Workbooks(classeur1).Sheets(1).Range("A65536").End(xlUp).Row + 1
Set Ws = Wb.Sheets(1)
Ws.Range("A1:i2000").Copy
Workbooks(classeur1).Sheets(1).Range("a" & x).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Wb.Close False
Fichier = Dir
Loop
...........................................