Macro pour importer donnees de plusieurs classeurs

Option Explicit

Sub Importer()
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String
Dim Ws As Worksheet, maPlageExp As String, Col As String
Dim Erreur As Boolean, maPlageImp As String

    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
    ThisWorkbook.Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "TravailEnCours"
    Sheets("FormulaireGC").Select 'ICI, peu importe le nom de la feuille, mets en un qui existe dans le classeur BDDBenoit2.xlsm
                                    'il faut juste sélectionner une autre feuille que celle que l'on vient d'ajouter
    Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
    '************************************A ADAPTER : tes fichiers sont ils tous .xls???
    fichier = Dir(Chemin & "*.xls")
    '************************************
    Do While Len(fichier) > 0
        If fichier <> ThisWorkbook.Name Then
            '****************************A ADAPTER : l'Array doit contenir le nom des feuilles à importer
                '!!!Précaution, assures toi que ces feuilles sont bien dans le classeur BDDBenoit2.xlsm
            For Each Ws In ThisWorkbook.Worksheets(Array("FormulaireGC", "FormulaireEsc", "FormulaireBV", "FormulairePortes", "FormulaireMC", "FormulairePC", "FormulairePB"))
                Erreur = False
                'ici on attribue la bonne plage en fonction de la feuille importée '*********** A ADAPTER
                    'maPlageExp est la plage de cellules des fichiers à importer
                    'maPlageImp est la même plage de cellules, mais dans le fichier BDDBenoit2.xlsm
                Select Case Ws.Name
                    Case "FormulaireGC"
                        maPlageExp = "FormulaireGC'!$A$2:$M$4"
                        maPlageImp = "A2:M4"
                        Col = "A"
                    Case "FormulaireEsc"
                        maPlageExp = "FormulaireEsc'!$A$2:$L$4"
                        maPlageImp = "A2:L4"
                        Col = "A"
                    Case "FormulaireBV"
                        maPlageExp = "FormulaireBV'!$A$2:$J$4"
                        maPlageImp = "A2:J4"
                        Col = "A"
                    Case "FormulairePortes"
                        maPlageExp = "FormulairePortes'!$I$2:$Q$4"
                        maPlageImp = "I2:Q4"
                        Col = "I"
                    Case "FormulaireMC"
                        maPlageExp = "FormulaireMC'!$A$2:$K$4"
                        maPlageImp = "A2:K4"
                        Col = "A"
                    Case "FormulairePC"
                        maPlageExp = "FormulairePC'!$A$2:$L$4"
                        maPlageImp = "A2:L4"
                        Col = "A"
                    Case "FormulairePB"
                        maPlageExp = "FormulairePB'!$A$2:$N$4"
                        maPlageImp = "A2:N4"
                        Col = "A"
                    Case Else
                        MsgBox "Feuille inconnue"
                        Erreur = True
                End Select
                If Erreur = False Then
                    ThisWorkbook.Names.Add "Plage", RefersTo:="='" & Chemin & "[" & fichier & "]" & maPlageExp
                    With Sheets("TravailEnCours")
                        .Range(maPlageImp) = "=Plage"
                        .Range(maPlageImp).Copy
                        ThisWorkbook.Sheets(Ws.Name).Range(Col & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                        .Cells.Clear
                    End With
                End If
            Next Ws
        End If
        fichier = Dir()
    Loop
    Application.DisplayAlerts = False
    Sheets("TravailEnCours").Delete
    Application.DisplayAlerts = True
End If
End Sub