Aggréger des données provenant de plusieurs classeurs

Option Explicit   
Option Base 1   
Sub extraire_books()   
Dim Dercol As Byte, Fich As String   
Dim T_ordre(), T_out()   
Dim Derlig As Long, Col As Byte, Lig As Long, Cptr As Byte, Ligvid As Long   

Application.ScreenUpdating = False   

With ThisWorkbook.ActiveSheet   
     'nettoie le tableau   
     .Range("A2:H65000").Clear   
     'mémorise l'ordre de restitution des champs   
     Dercol = .Rows(1).Find("*", , , , , xlPrevious).Column 
     T_ordre = .Range(.Cells(1, "A"), .Cells(1, Dercol)).Value   
     ReDim T_out(Dercol, 1)   
End With   

'le dossier des souce devient le dossier actif   
ChDir "D:\documents\ccm" '  A ADAPTER   
Fich = Dir("*.xls")   

'parcours le dossier   
While Fich <> ""   
     If Fich <> ThisWorkbook.Name Then   
     Workbooks.Open Fich   
          With ActiveSheet   
               'dernière mligne occupée   
               Derlig = .Cells.Find("*", , , , , xlPrevious).Row   
               'mémorise la taille des données à transfèrer   
               ReDim Preserve T_out(Dercol, Derlig)   
               For Cptr = 1 To Dercol   
                    'recherche la position du champ dans le fichier source   
                    Col = Rows(1).Find(T_ordre(1, Cptr)).Column   
                    For Lig = 2 To Derlig   
                         T_out(Cptr, Lig - 1) = .Cells(Lig, Col)   
                    Next Lig   
               Next Cptr   
          End With   
      ActiveWorkbook.Close   
      'restitution   
      With ThisWorkbook.ActiveSheet   
          Ligvid = .Columns("A").Find("").Row   
          With .Cells(Ligvid, "A").Resize(Derlig, Dercol)   
               .Value = Application.Transpose(T_out)   
               .Borders.Weight = xlThin   
          End With   
      End With   
     End If   
     'recherche le fichier suivant   
     Fich = Dir   
Wend   
End Sub