Excel Macro Extraction Données

Option Explicit

Sub ExtractionDonnéesClasseursMultiples()
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String

With 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")
    With Sheets("Extraction")
        .[A1] = fichier
    End With
    Do While Len(fichier) > 0
        If fichier <> ThisWorkbook.Name Then
            ThisWorkbook.Names.Add "Plage", _
            RefersTo:="='" & Chemin & "[" & fichier & "]Feuil1'!$A$1:$L$50"
            With Sheets("Feuil2")
                .[A1:L50] = "=Plage"
                .[A1:L50].Copy
                Sheets("Extraction").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            End With
        End If
        fichier = Dir()
        With Sheets("Extraction")
            .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = fichier
        End With
    Loop
End If
With Sheets("Feuil2")
    .[A1:L50].Clear
End With
End Sub

Tabl = Sheets("Feuil1").Range("A9:K42") ' A ADAPTER SI PLUS DE 11 Colonnes et 33 Lignes...

Tabl = Range("A9:K42") ' A ADAPTER SI PLUS DE 11 Colonnes et 33 Lignes...