复制范围到新的工作簿 – 不复制，错误9
我收到运行时错误“9”：
下标超出范围。
错误发生在最后..我试图打开一个新的电子表格，将编辑的信息复制到它，然后我将使用此脚本以转储8-12多个文件基于selectINTO'FName'…可能会或可能不会工作。
当我点击debugging时，这被突出显示：
Workbooks("TFR7").Sheets("Sheet1").Range("A2:V" & LastRow).Copy Destination:=Workbooks(FName).Sheets("Sheet1").Range("A1") 我不明白这里的错误？ 是我的范围select复制？
附注：我正在努力学习如何删除select的实例等FYI
代码如下：
Sub OpenReportThenEdit() 'This will open a designated report and edit it 'File pathway and name must be correct 'Any adjustments to file layout could 'break' macro 'First file will always be TFR7 and from there can go into more 'Currently only works for TFR7 Application.ScreenUpdating = False Dim wb As Excel.Workbook Dim LastRow As Long Dim FName As String 'Open a report, delete header/footer rows Set wb = Workbooks.Open("C:\Users\USER\Downloads\TFR7", False, False) wb.Sheets(1).Rows("1:5").EntireRow.Delete wb.Sheets(1).Range("A" & Rows.Count).End(xlUp).EntireRow.Delete wb.Sheets(1).Range("A" & Rows.Count).End(xlUp).EntireRow.Delete wb.Sheets(1).Range("J" & Rows.Count).End(xlUp).EntireRow.Delete 'Edit Sheet Font/Size With Worksheets("Sheet1").Cells.Font .Name = "Arial" .Size = 9 End With 'Edit Sheet Alignment, etc. With Worksheets("Sheet1").Cells .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False .HorizontalAlignment = xlRight .VerticalAlignment = xlBottom .WrapText = False End With 'Replace 'text to columns' and convert dates to Excel Date Value before 'Paste Values' to remove formula Columns("L:O").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Range("L2").FormulaR1C1 = "=DATEVALUE(LEFT(RC[4],10))" Range("L2").Copy Destination:=Range("L2:O2") LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row Range("L2:O" & LastRow).FillDown Range("P1:S1").Copy Destination:=Range("L1:O1") Columns("L:O").Select Application.CutCopyMode = False Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Selection.NumberFormat = "m/d/yyyy" 'Delete old date columns, remove duplicate values (by tracking numbers) Columns("P:S").Select Selection.Delete Shift:=xlToLeft ActiveSheet.Range("A1:V" & LastRow).RemoveDuplicates Columns:=19, Header:= _ xlYes 'Select cells with values, turn them blue (because silly people want them blue) LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row ActiveSheet.Range("A2:V" & LastRow).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent1 .TintAndShade = 0.399975585192419 .PatternTintAndShade = 0 End With 'Open Workbook, set Workbook as Destination for FName = "C:\Users\USER\Downloads\Daily_" & _ Format(Date, "mmdd") & ".xlsm" Workbooks.Add.SaveAs Filename:=FName, _ FileFormat:=xlOpenXMLWorkbookMacroEnabled Workbooks("TFR7").Sheets("Sheet1").Range("A2:V" & LastRow).Copy Destination:= _ Workbooks(FName).Sheets("Sheet1").Range("A1") Application.ScreenUpdating = True End Sub
改用对象：
Dim otherWB As Excel.Workbook '// other code here Set otherWB = Workbooks.Add otherWB.SaveAs Filename:=FName, FileFormat:=xlOpenXMLWorkbookMacroEnabled '// wb is already set to original workbook, otherWB is set to new workook wb.Sheets("Sheet1").Range("A2:V" & LastRow).Copy Destination:=otherWB.Sheets("Sheet1").Range("A1")