regrouper plusieurs classeurs en un seul excel2003

Bonjour le forum,

Voilà j'ai 35 classeurs excel ayant tous la même structure situés dans un même dossier et je souhaite les regrouper en un seul classeur. Pour cela dans le dossier j'ai créer un classeur nommé "global" puis quelqu'un du forum m'avait filé un coup de main pour créer une macro (cf ci-dessous) qui fonctionnait très bien et qui s'appelait ThisWorkbook.regroupe
Depuis hier la macro ne regroupe qu'un seul classeur et laisse ouvert le 2eme classeur de la liste. Je ne sais pas d'où vient le problème? Pourriez vous m'aider svp car là je sèche.
Je mets en pièce jointes les fichiers à regouper et le fichier global.
Merci d'avance pour votre aide.

Friends__59



Sub regroupe()
Dim chemin As String ' classeur regroupé
Dim rep As String ' répertoire à traiter
Dim fic As String ' classeur regroupé
Dim ligne As Long ' ligne écriture
Dim nbc As Integer ' nombre de classeurs
Dim nbf As Integer ' nombre de feuilles
Dim nbl As Integer ' nombre de lignes
Dim c As Integer ' nombre de colonnes
Dim l As Long ' ligne lecture
Dim Wf As Worksheet ' feuille regroupement
Dim Wl As Worksheet ' feuille regroupée
rep = ThisWorkbook.Path & "\"
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
On Error GoTo fin
Set Wf = ThisWorkbook.ActiveSheet ' variable feuille groupe
Wf.Cells.ClearContents
nbc = 0: nbf = 0 ' initialisation variables
ligne = 1
fic = Dir(rep & "*.xls") ' recherche fichiers
While fic <> ""
If fic <> ThisWorkbook.Name Then
chemin = rep & fic ' chemin fichiers
Workbooks.Open chemin, 0 ' ouverture
Set Wl = ActiveWorkbook.Sheets(1)
nbl = Wl.UsedRange.Rows.Count
c = Wl.UsedRange.Columns.Count
If ligne > 2 Then l = 2 Else l = 1 ' une seule fois le titre
Wl.Cells(l, 1).Resize(nbl, c).Copy Destination:=Wf.Cells(ligne, 1)
ligne = ligne + nbl - l + 1
nbf = nbf + 1
ActiveWorkbook.Close SaveChanges:=False ' Fermeture du classeur
nbc = nbc + 1
End If
fic = Dir
Wend
fin:
MsgBox nbc & " classeurs regroupés avec " & nbf & " feuilles et " & ligne & " lignes"
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub