2017-05-05 14 views
2

実行時エラー '9'が表示されます。範囲を新しいブックにコピー - コピーしません。エラー9

添字が範囲外です。

エラーが最後に発生しました。新しいスプレッドシートを開いて編集した情報をコピーしようとしています。この後にスクリプトを使用して、選択肢INTO 'FName'に基づいて8-12個のファイルをダンプします。 ...動作するかもしれないし、動作しないかもしれない。

これは私がデバッグ]をクリックしたときに強調表示されています:

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 
+0

待ち、私は 'FName'を何らかの形の変数として設定する必要がありますか?これに7日間、自分自身を教えてください、誰かが正しい方向に私を指すことができる場合、私は非常に感謝します。 – dduz

+1

エラーの理由は、 'Workbooks(" C:\ Users \ USER \ Downloads \ Daily_0506.xlsm ")'は動作しません、 'Workbooks(" Daily_0506.xlsm ") '(つまり、パスなし)。マクロマンの答えは問題を解決するはずです。 – YowE3K

答えて

4

は仕事:

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") 
関連する問題