2
我收到运行时错误'9':复制范围到新的工作簿 - 不复制,错误9
下标超出范围。
错误发生在最后..我试图打开一个新的电子表格,将编辑的信息复制到它,然后我将使用此脚本以转储8-12多个文件根据选择INTO'FName' ...可能会或可能不会工作。
Workbooks("TFR7").Sheets("Sheet1").Range("A2:V" & LastRow).Copy Destination:=Workbooks(FName).Sheets("Sheet1").Range("A1")
我不明白这里的错误:
这当我点击调试突出显示?是我的范围选择复制吗?
附注:我正在学习如何去除的选择等实例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
等待,我是否需要'设置FName'作为某种形式的变量? 7天后,告诉我自己,如果任何人都能指引我走向正确的方向,我将非常感激。 – dduz
错误的**原因**是Workbooks(“C:\ Users \ USER \ Downloads \ Daily_0506.xlsm”)不起作用,它只需要工作簿(“Daily_0506.xlsm”) '(即没有路径)。宏观人的答案应该可以解决问题。 – YowE3K