使用宏将数据复制到新Excel工作表时出错

时间:2016-01-27 16:30:27

标签: excel excel-vba vba

这是我在这里的第一篇文章。

在主工作表中过滤后,我试图将数据从一张工作表复制到同一工作簿中的新工作表。

我还必须将工作表模板从模板表复制到我在复制数据之前复制数据的新工作表上。

这是我的宏中显示的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:下标超出范围

猜猜它与表格编号有关但却无法弄清楚它是什么。

1 个答案:

答案 0 :(得分:0)

只是因为你已经解决了这个问题,请看看我为你准备的代码。在制作新的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