Importer des données d'un classeur2 vers un classeur1

'workfile = Dir(myPath & "*.xls")
    'workfile = Dir(myPath & ".xls")
    'workfile = "Clas2.xls"
    workfile = [D1]

'workfile = Dir(myPath & "*.xls")
    'workfile = Dir(myPath & ".xls")
    'workfile = "Clas2.xls"
    workfile = [D1] & ".xls"

'========= Choix en D1 du fichier à traiter (attention en D1 doit être le nom du fichier AVEC l'extension)
Private Sub Worksheet_Change(ByVal Target As Range)

    Application.ScreenUpdating = False
    If Target.Address = "$D$1" Then WbkOpenCopy

End Sub


'========= Ouvre le Classeur dont le nom (avec l'extension) ont été choisis en D1
'          Le classeur à ouvrir se trouve dans le même dossier que le fichier de la macro
Private Sub WbkOpenCopy()
    Dim MyPath As String, WorkFile As String
    Dim LastLig As Long
    Dim Wbk As Workbook
    Dim Sh As Worksheet

    Application.ScreenUpdating = False
    With ThisWorkbook.Worksheets("Feuil1")
        WorkFile = .Range("D1").Value

        If WorkFile <> "" Then
            MyPath = ThisWorkbook.Path & "\"
            WorkFile = WorkFile & ".xls"
            If Dir(MyPath & WorkFile) <> "" Then
                Application.StatusBar = "Now working on " & WorkFile
                Application.DisplayAlerts = False
                Set Wbk = Workbooks.Open(MyPath & WorkFile)
                Set Sh = Wbk.Worksheets(1)
                LastLig = Sh.Cells(Sh.Rows.Count, "A").End(xlUp).Row

                Application.EnableEvents = False
                .Range("D2", .Cells(.Rows.Count, "D").End(xlUp)).ClearContents
                .Range("D2:D" & LastLig).Value = Sh.Range("A2:A" & LastLig).Value
                'Sh.Range("A2:A" & LastLig).Copy .Range("D2:D" & LastLig)
                Application.EnableEvents = True

                Set Sh = Nothing
                Wbk.Close False
                Set Wbk = Nothing
                Application.DisplayAlerts = True
                Application.StatusBar = False
            End If
        End If
    End With
End Sub