2016-11-03 11 views
0

ワークシートの8つの異なるテーブルから8つの異なる範囲をコピーしようとしています。だから私はこのコーディングを以下に思いついた。私は、これらの範囲を結合するために労働組合法を使用しますが、それはvba - ランタイムエラー '9':下付き文字範囲外

実行時エラーが返された「9」:添字が範囲外

次の行Set range1 = Sheets("Sheet1").Range("O24")で。

どこに間違っていたのか教えていただけますか?私は自分の間違いがどこにあるかを検出できないようです。

Sub ONSHORE() 

'Last cell in column 
Dim WS As Worksheet 
Dim LastCell As Range 
Dim LastCellRowNumber As Long 
Dim range1 As Range, range2 As Range, range3 As Range, range4 As Range, range5 As Range, range6 As Range, range7 As Range, range8 As Range, multipleRange As Range 

Set range1 = Sheets("Sheet1").Range("O24") 
Set range2 = Sheets("Sheet1").Range("AA40, AC40") 
Set range3 = Sheets("Sheet1").Range("AA56, AC56") 
Set range4 = Sheets("Sheet1").Range("AA72, AC72") 
Set range5 = Sheets("Sheet1").Range("AA88, AC88") 
Set range6 = Sheets("Sheet1").Range("AA104, AC104") 
Set range7 = Sheets("Sheet1").Range("AA120, AC120") 
Set range8 = Sheets("Sheet1").Range("AA130, AC130") 
Set multipleRange = Union(range1, range2, range3, range4, range5, range6, range7, range8) 

Set WS = Worksheets("Sheet1") 

Dim wb As Workbook, wb2 As Workbook 
Dim vFile As Variant 
Dim i As Integer 

'Set source workbook 
Set wb = ActiveWorkbook 

'Open the target workbook 
vFile = Application.GetOpenFilename("Excel-files,*.xlsx", MultiSelect:=True) 

If IsArray(vFile) Then 
    For i = LBound(vFile) To UBound(vFile) 
     Set wb2 = Workbooks.Open(vFile(i)) 

     'if the user didn't select a file, exit sub 
     If TypeName(vFile) = "Boolean" Then Exit Sub 

     With WS 
      Set LastCell = .Cells(.Rows.Count, "D").End(xlUp) 
      LastCellRowNumber = LastCell.Row + 1 
     End With 

     'Set selectedworkbook 
     Set wb2 = ActiveWorkbook 

     'Select cells to copy 
     wb2.Worksheets("Sheet1").Range(multipleRange).Copy 

     'Go back to original workbook you want to paste into 
     wb.Activate 

     'Paste starting at the last empty row 
     wb.Worksheets("Sheet1").Range("D" & LastCellRowNumber).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 

     'Close and save the workbook you copied from 
     wb2.Save 
     wb2.Close 
    Next i 

    Application.ScreenUpdating = True 
    Application.CutCopyMode = False 
End If 

End Sub 
+0

"Sheet1"という名前のシートがありますか? 'Set WS = Worksheets(" Sheet1 ")'の行をこれらの行の上に置くとエラーを返しますか? –

+0

あなたが言ったようにコーディングを変更しました。それでもエラーは返されました。 – Deve1

+0

つまり、 "Sheet1"という名前のシートはありません。 –

答えて

2

私はSheets("Sheet1")が存在しないと推測しています。それにはスペースがありますSheets("Sheet 1")

範囲を結合する理由はありません。以下のコードはあなたの組合に似ています。

設定multipleRange =シート( "シート1")。レンジ( "O24、AA40、AA56、AA72、AA88、AA104、AC120、AA130")シート1だったとき、私は、エラー9を得た

+0

私はあなたのコードを試みたが、それはあなたのコードに同じエラーを返します。 – Deve1

+0

「Sheet1」という名前のワークシートがないため、エラーが発生しています。 –

0

シート1に範囲内のデータがない場合にエラー1004が発生します。だから、あなたの問題に対する答えはsheet1がありません。

関連する問題