XL 2016 Copier coller dans nouveau classeur

Option Explicit

Sub MacroRecorder()
    Range("A3:M45").Select
    Selection.Copy
    Workbooks.Add
    Range("A3").Select
    ActiveSheet.Paste
    Range("A1").Select
    Application.CutCopyMode = False
    ChDir "C:\Test"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Test\Classeur1.xlsb" _
        , FileFormat:=xlExcel12, CreateBackup:=False
    ActiveWindow.Close
    Range("A1").Select
End Sub

Sub Copie()
Application.ScreenUpdating = False
Dim chemin, fichier
    chemin = ThisWorkbook.Path & "\Dossier\"
    If Dir(chemin, vbDirectory) = "" Then MkDir chemin
    fichier = "test"
    Range("A1:C9").Copy
    Workbooks.Add
   ActiveSheet.[A1].Select
     With Selection
    .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    .PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    End With
                     Application.ScreenUpdating = False
                     Application.DisplayAlerts = False
    With ActiveWorkbook
    .SaveAs chemin & fichier, 51
    .Close
    End With
End Sub/CODE]

Option Explicit

Sub CopierCollerSauver()
Dim WkbDepart As Workbook, WkbDestination As Workbook
Dim Wsh As Worksheet, sNomFichierDestination As String

    Application.ScreenUpdating = False

    Set WkbDepart = ThisWorkbook
    Set WkbDestination = Workbooks.Add

    Set Wsh = WkbDestination.Worksheets(1)
    Wsh.Name = "Destination"

    WkbDepart.Worksheets(Feuil1.Name).Range("A3:M45").Copy
    With WkbDestination
        .Worksheets(Wsh.Name).Range("A3").PasteSpecial Paste:=xlPasteValues    'xlPasteAll
        .Worksheets(Wsh.Name).Range("A3").PasteSpecial Paste:=xlPasteFormats
        .Worksheets(Wsh.Name).Range("A1").Select
    End With

    With Application
        .CutCopyMode = False
        .DisplayAlerts = False
    End With

    sNomFichierDestination = "Destination.xlsb"
    With WkbDestination
        .SaveAs Filename:=ThisWorkbook.Path & "\" & sNomFichierDestination, FileFormat:=xlExcel12
        .Close SaveChanges:=False
    End With

    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

    WkbDepart.Worksheets(Feuil1.Name).Range("A1").Select

    Set Wsh = Nothing
    Set WkbDestination = Nothing
    Set WkbDepart = Nothing
End Sub