Ошибка копирования данных в новый лист Excel с использованием макроса

Question

Это мой первый пост здесь.

Я пытаюсь скопировать данные с одного листа на новый лист в той же книге после фильтрации на основном листе.

Мне также нужно скопировать шаблон листа из листа шаблона на этот новый лист, где я копирую данные, прежде чем копировать данные.

Это код VBA показано в моем макросе:

Sub Macro7() 
' 
' Macro7 Macro 
' 

' 
    Sheets("Template").Select 
    Rows("1:3").Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Dim sSheetName As String 
    Sheets.Add After:=Sheets(Sheets.Count) 
    sSheetName = ActiveSheet.Name 

    ActiveSheet.Paste 
    Sheets("Sheet1").Select 
    Range("N13").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("sSheetName").Select 
    Range("D4").Select 
    ActiveSheet.Paste 
    Columns("D:D").EntireColumn.AutoFit 
    Sheets("Sheet1").Select 
    Range("A13").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("sSheetName").Select 
    Range("C4").Select 
    ActiveSheet.Paste 
    Sheets("Sheet1").Select 
    Range("D13").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("sSheetName").Select 
    Range("E4").Select 
    ActiveSheet.Paste 
    Sheets("Sheet1").Select 
    Range("B13").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("sSheetName").Select 
    Range("F4").Select 
    ActiveSheet.Paste 
    Sheets("Sheet1").Select 
    Range("H13").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("sSheetName").Select 
    Range("G4").Select 
    ActiveSheet.Paste 
    Sheets("Sheet1").Select 
    Range("F13").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    Sheets("sSheetName").Select 
    Range("I4").Select 
    ActiveSheet.Paste 
    Range("A4").Select 
    Application.CutCopyMode = False 
    ActiveCell.FormulaR1C1 = "Fives Cinetic Corp" 
    Columns("B:B").Select 
    Columns("A:A").ColumnWidth = 17.57 
    Range("A4").Select 
    Selection.AutoFill Destination:=Range("A4:A5") 
    Range("A4:A5").Select 
    Range("D10").Select 
End Sub 

Я получаю сообщение об ошибке: Ошибка выполнения 9: Subscript из диапазона

Угадайте его что-то делать с номерами листов, но не в состоянии понять, что именно.

Answer 1

Просто убедитесь, что вы еще не решили это, посмотрите на код, который я адаптировал для вас. При создании новых проектов VBA, играйте с некоторыми из этих методов, вы обнаружите, что они намного быстрее и надежнее, чем предыдущая. Сравните их рядом.

Это сделало много предположений с моей стороны, поэтому сделайте резервную копию, прежде чем запускать ее, чтобы проверить ее и убедиться, что все идет в нужном месте.

Sub Macro7() 

    Sheets.Add After:=Sheets(Sheets.Count) 
    NewSheet = ActiveSheet.Name 
    Sheets("Template").Rows("1:3").Copy Destination:=ActiveSheet.Range("A1") 

    Sheets("Sheet1").Activate 
    Range("N13").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Copy Destination:=Sheets(NewSheet).Range("D4") 

    With Sheets(NewSheet) 
     Columns("D:D").EntireColumn.AutoFit 
    End With 

    Range("A13").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Copy Destination:=Sheets(NewSheet).Range("C4") 

    Range("D13").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Copy Destination:=Sheets(NewSheet).Range("E4") 

    Range("B13").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Copy Destination:=Sheets(NewSheet).Range("F4") 

    Range("H13").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Copy Destination:=Sheets(NewSheet).Range("G4") 

    Range("F13").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Copy Destination:=Sheets(NewSheet).Range("I4") 

    Sheets(NewSheet).Activate 
    Range("A4").Value = "Fives Cinetic Corp" 
    Columns("A:A").AutoFit 
    Range("A4").AutoFill Destination:=Range("A4:A5") 
    Range("D10").Select 
End Sub