使用宏将数据复制到新 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：下标超出范围

猜测它与图纸编号有关，但无法弄清楚它到底是什么。

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