CODEWITHSUNDEEP
vbaexcel
Deve1
Deve1

Reputation: 1

vba - run time error '9': Subscript out of range

I am trying to copy 8 different ranges from 8 different tables in a worksheet. So I came up with this coding below. I used union method to combine these ranges, but it returned a

run-time error '9': Subscript out of range

at the following line Set range1 = Sheets("Sheet1").Range("O24").

Can anyone tell me where I did wrong? I can't seem to detect where is my mistake.

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

Upvotes: 0

Views: 6369

Answers (2)

Mukul Varshney
Mukul Varshney

Reputation: 3141

I got the error 9 when sheet1 was missing while error 1004 when sheet1 is there with no data in range. So the answer for your problem is sheet1 missing.

Upvotes: 0

user6432984
user6432984

Reputation:

I'm guessing that Sheets("Sheet1") does not exist. It could have a space in it Sheets("Sheet 1").

There is no reason to union the ranges. The code below is analogous to your union.

Set multipleRange = Sheets("Sheet1").Range("O24, AA40, AA56, AA72, AA88, AA104, AC120, AA130 ")

Upvotes: 2

Related Questions