Копировать содержимое листа одной книги, на лист в новую книгу с присвоением ей имени листа из которого копировали

[quote="Burk;13746932"]строку 12 уберите, пропустил[/quote]

Sub VigruzkaZakaza()
 
Application.ScreenUpdating = False
 Dim New_Wb As Workbook
    Set New_Wb = Workbooks.Add
    New_Wb.Activate
    New_Wb.SaveAs ("D:\" & ThisWorkbook.ActiveSheet.Range("A1") & ".xlsx")
    'New_Wb.Close
    
'копирую данные с листа
    Workbooks("Заказы-производства.xlsm").Activate
    ActiveSheet.Cells.Copy
    'Cells.Select
'Selection.Copy
  Workbooks("Бланк-Заказ.xlsx").Activate
    Cells.Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
        
End Sub

n = ActiveWorkbook.Sheets(1).Name
'а перед 23
ActiveWorkbook.SaveAs ИмяПапки & n & ".xlsx", xlWorkbookNormal

Sub VigruzkaZakaza2()
    Application.ScreenUpdating = False
    Dim New_Wb As Workbook, K As Integer
    Set New_Wb = Workbooks.Add
    K = New_Wb.Sheets.Count + 2 'номер копии в новой книге
'   копирую данные с листа
 
    Workbooks("Заказы-производства.xlsm").Activate
    n = ActiveWorkbook.Sheets(1).Name
    Sheets(1).Copy Before:=New_Wb.Sheets(1)
    New_Wb.Activate
    
    StartLine = 1
    EndLine = New_Wb.VBProject.VBComponents(K).CodeModule.CountOfLines
    New_Wb.VBProject.VBComponents(K).CodeModule.DeleteLines StartLine, (EndLine - StartLine + 1)
    Application.CutCopyMode = False
     Application.ScreenUpdating = True
    Application.CutCopyMode = False
End Sub