Macro extraction données excel

Bonjour,

est-ce que quelqu'un pourrait me donner un coup de main pour modifier ce code afin que la feuille dans le fichier source (nommée Extration) copie un tableau (A9:K42) dans les fichiers concernés ?

Lorsque j'active le commandbutton, le fichier source me demande d'ouvrir le dossier dans lequel les fichiers à extracter sont enregistrés et il n'arrive pas à copier les tableaux les uns à la suite des autres comme j'espérais... :(

Voici mon code relié au commandbutton:

Private Sub CommandButton1_Click()

Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String, Tabl, Wbk As Workbook

Set Wbk = ActiveWorkbook
With Wbk.Sheets("Extraction")
.Cells.Clear
End With
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)

If objFolder Is Nothing Then
MsgBox "Abandon opérateur", vbCritical, "Annulation"
Else
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
fichier = Dir(Chemin & "*.xls")
Application.ScreenUpdating = False
With Wbk.Sheets("Extraction")
.[A1] = fichier
End With
Do While Len(fichier) > 0
If fichier <> ThisWorkbook.Name Then
Workbooks.Open Chemin & fichier
Tabl = Range("A9:K42") ' A ADAPTER SI PLUS DE 11 Colonnes et 33 Lignes...
With Wbk.Sheets("Extraction")
.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(Tabl, 2), UBound(Tabl, 1)) = Application.Transpose(Tabl)

End With
ActiveWorkbook.Close
End If
fichier = Dir()
With Sheets("Extraction")
.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Tabl
End With
Loop
End If
Application.ScreenUpdating = True



End Sub


Merci beaucoup de votre temps
Martin