Option Explicit
Sub transfert()
Dim MyArray() As String
Dim i As Integer, X As Byte
Dim j As Integer
Dim k As Integer
Dim nb As Integer
Dim n As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
n = Workbooks.Count
nb = Workbooks(n).Sheets.Count
For i = 1 To n - 1 'boucle jusqu'à l'avant dernier classeur, le dernier étant le classeur de destination des données
Workbooks(i).Activate
k = Workbooks(i).Worksheets.Count
For j = 1 To k 'copie des onglets du classeur i
ReDim Preserve MyArray(X)
MyArray(X) = Sheets(j).Name
X = X + 1
Next j
Workbooks(i).Worksheets(MyArray).Copy before:=Workbooks(n).Sheets("Sheet1")
Next i
End Sub