XL 2010 fusionner plusieurs classeurs excel en un seul classeur

Private Sub CommandButton1_Click()
Dim a(), s As Object, fichier, i%
ReDim a(1 To 2) 'dimension à adapter
a(1) = ThisWorkbook.Path & "\Classeur1.xlsx" 'à adapter
a(2) = ThisWorkbook.Path & "\Classeur2.xlsx" 'à adapter
'etc...
'---supression des feuilles---
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each s In Sheets
    If s.Name <> Me.Name Then s.Delete
Next s
'---copie des feuilles des fichiers---
For Each fichier In a
    With Workbooks.Open(fichier)
        For i = 1 To .Sheets.Count
            .Sheets(i).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Left(.Name, 31 - Len(CStr(i)) - 2) & "(" & i & ")"
        Next i
        .Close
    End With
Next fichier
Me.Activate
End Sub