Macro excel vba et copier coller entre classeur

Option Explicit

Sub Import()
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String
Dim Colonne As Byte

    'ouverture de la fenêtre de choix du répertoire
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
'Si l'utilisateur annule sans choisir
If objFolder Is Nothing Then
    'message
    MsgBox "Abandon opérateur", vbCritical, "Annulation"
Else 'sinon
    'Chemin = répertoire choisi
    Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
    'Choix du 1er fichier
    fichier = Dir(Chemin & "*.xls*")
    'Colonne = n° de colonne ou on va coller les données
        'pour commencer colonne A, laisser à 0, pour commencer colonne B remplacer 0 par 1 etc...
    Colonne = 0
    'on boucle sur tous les fichiers excel du répertoire choisi
    Do While Len(fichier) > 0
        Colonne = Colonne + 1
        If fichier <> ThisWorkbook.Name Then
            'attribue un nom dans le classeur, se référant à la plage à importer : B2:I18
            ThisWorkbook.Names.Add "Plage", RefersTo:="='" & Chemin & "[" & fichier & "]fiche site'!$B$2:$I$18"
            With Sheets("Feuil2")
                ' "Importe les données" grâce au nom donné ci-dessus
                .[B2:I18] = "=Plage"
                .[B3:B10].Copy 'Copie B3:B10
            End With
            With Sheets("Feuil1")
                .Cells(1, Colonne).PasteSpecial xlPasteValues 'Colle B3:B10
            End With
            With Sheets("Feuil2")
                .[B16].Copy 'Copie B16
            End With
            With Sheets("Feuil1")
               .Cells(9, Colonne).PasteSpecial xlPasteValues 'Colle B16
            End With
            With Sheets("Feuil2")
                .[B18].Copy 'copie B18
            End With
            With Sheets("Feuil1")
               .Cells(10, Colonne).PasteSpecial xlPasteValues 'Colle B18
            End With
            With Sheets("Feuil2")
                .[G2].Copy 'Copie G2
            End With
            With Sheets("Feuil1")
               .Cells(11, Colonne).PasteSpecial xlPasteValues 'Colle G2
            End With
            With Sheets("Feuil2")
                .[I2].Copy  'Copie I2
            End With
            With Sheets("Feuil1")
               .Cells(12, Colonne).PasteSpecial xlPasteValues 'Colle I2
            End With
            With Sheets("Feuil2")
                .[G3].Copy 'Copie G3
            End With
            With Sheets("Feuil1")
               .Cells(13, Colonne).PasteSpecial xlPasteValues 'Colle G3
            End With
            With Sheets("Feuil2")
                .[I3].Copy  'Copie I3
            End With
            With Sheets("Feuil1")
               .Cells(14, Colonne).PasteSpecial xlPasteValues 'Colle I3
            End With
        End If
        fichier = Dir()
    Loop
End If
End Sub