XL 2013 VBA copier coller deux feuilles

Sub Extraction()
'copie de test vers base -'colA vers colA - 'colD vers colD - 'colT vers colG - 'colU vers colJ

    Dim filePath As String, TestWb As Workbook, BaseWb As Workbook, dl As Long

    Set BaseWb = ActiveWorkbook

    With BaseWb.Sheets("feuil1") 'on vide' les colonnes concernées
        dl = .UsedRange.Rows(.UsedRange.Rows.Count).Row
        Application.Union(.Range("A2:A" & dl), .Range("D2:D" & dl), .Range("G2:G" & dl), .Range("J2:J" & dl)).Cells.ClearContents
    End With

    filePath = ThisWorkbook.Path & Application.PathSeparator & "test.xlsx"    'chemin à adapter

    Set TestWb = Workbooks.Open(filePath) 'on ouvre le fichier'
    With TestWb.Sheets("feuil1")
        dl = .UsedRange.Rows(.UsedRange.Rows.Count).Row

        .Range("A2:A" & dl).Copy BaseWb.Sheets("feuil1").Range("A2")
        .Range("D2:D" & dl).Copy BaseWb.Sheets("feuil1").Range("D2")
        .Range("T2:T" & dl).Copy BaseWb.Sheets("feuil1").Range("G2")
        .Range("U2:U" & dl).Copy BaseWb.Sheets("feuil1").Range("J2")
    End With
    TestWb.Close 'on ferme le fichier'

    MsgBox "Extraction terminée!"

End Sub

Sub ExtractionChoixFichier()
'copie de test vers base -'colA vers colA - 'colD vers colD - 'colT vers colG - 'colU vers colJ

    Dim filePath As String, TestWb As Workbook, BaseWb As Workbook, dl As Long

    Set BaseWb = ActiveWorkbook

    With BaseWb.Sheets("feuil1")
        dl = .UsedRange.Rows(.UsedRange.Rows.Count).Row
        Application.Union(.Range("A2:A" & dl), .Range("D2:D" & dl), .Range("G2:G" & dl), .Range("J2:J" & dl)).Cells.ClearContents
    End With

    'ouvrir fenetre choix fichier
    Dim Nom_Fichier As Variant

    Nom_Fichier = Application.GetOpenFilename("Fichiers Excel (*.xlsx), *.xlsx")
    If Nom_Fichier <> False Then
        Set TestWb = Workbooks.Open(Nom_Fichier)
        TestWb.Activate
    End If

    With ActiveSheet
        dl = .UsedRange.Rows(.UsedRange.Rows.Count).Row

        .Range("A2:A" & dl).Copy
        BaseWb.Sheets("feuil1").Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        .Range("D2:D" & dl).Copy
        BaseWb.Sheets("feuil1").Range("D2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        .Range("T2:T" & dl).Copy
        BaseWb.Sheets("feuil1").Range("G2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        .Range("U2:U" & dl).Copy
        BaseWb.Sheets("feuil1").Range("J2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End With
    TestWb.Close

    MsgBox "Extraction terminée!"

End Sub

Sub ExtractionChoixFichier()
'copie de test vers base -'colA vers colA - 'colD vers colD - 'colT vers colG - 'colU vers colJ

    Dim filePath As String, TestWb As Workbook, BaseWb As Workbook, dl As Long
    Application.ScreenUpdating = False
    Set BaseWb = ActiveWorkbook

    With BaseWb.Sheets("feuil1")
        dl = .UsedRange.Rows(.UsedRange.Rows.Count).Row
        Application.Union(.Range("A2:A" & dl), .Range("D2:D" & dl), .Range("G2:G" & dl), .Range("J2:J" & dl)).Cells.ClearContents
    End With

    'ouvrir fenetre choix fichier
    Dim Nom_Fichier As Variant

    Nom_Fichier = Application.GetOpenFilename("Fichiers Excel (*.xlsx), *.xlsx")
    If Nom_Fichier <> False Then
        Set TestWb = Workbooks.Open(Nom_Fichier)
        TestWb.Activate
    End If

    '''choix onglet
    Dim Source As String
    Source = InputBox("Saisir nom de l'onglet à copier")
    If Source = "" Then GoTo fin    'si aucune saisie nom onglet
    If Existe(Source) Then    'verification onglet existe
        With Sheets(Source)
            dl = .UsedRange.Rows(.UsedRange.Rows.Count).Row
            .Range("A2:A" & dl).Copy
            BaseWb.Sheets("feuil1").Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            .Range("D2:D" & dl).Copy
            BaseWb.Sheets("feuil1").Range("D2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            .Range("T2:T" & dl).Copy
            BaseWb.Sheets("feuil1").Range("G2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            .Range("U2:U" & dl).Copy
            BaseWb.Sheets("feuil1").Range("J2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End With
        MsgBox "Extraction terminée!"
    Else
        MsgBox "L'onglet " & Source & " n'existe pas dans le fichier " & Dir(Nom_Fichier)

    End If
fin:
    TestWb.Close
    Application.ScreenUpdating = True

End Sub

Function Existe(nom) As Boolean 'mapomme
   On Error Resume Next: Existe = IsObject(Sheets(nom)): Err.Clear
End Function