Subscript out of range – Run-time error '9'

February 7, 2023

I am trying to get a the data from a column in 4 sheets and combine them together. The number of rows can change so I need to automate this to do this automatically. All of these sheets are contained in a single workbook. This workbook is open.

I am using this code to try to accomplish this but I am getting subscript out of range. I believe this tells me that I am referencing somewhere outside of my array but I can’t seem to find it. Debugging points me to the For loop but it seems okay to me? Each of the array elements is a different worksheet in my workbook. The data in each worksheet is simply a player name.

Sub CopyRange()
    Dim bottomD As Integer
    Dim ws As Worksheet
    For Each ws In Sheets(Array("Batters (OF) - Bat X", "Batters (SS) - Bat X", "Batters (3B) - Bat X", "Batters (2B) - Bat X"))
        ws.Activate
        bottomD = Range("Batters (OF) - Bat X" & Rows.Count).End(xlUp).Row
        Range("A2:D" & bottomD).Copy Sheets("Batters - Bat X").Cells(Rows.Count, "Batters (OF) - Bat X").End(xlUp).Offset(1, 0)
    Next ws
End Sub

>Solution :

Copy the Same Columns From Different Worksheets

Sub CopyColumns()
    
    Dim swsNames(): swsNames = Array( _
        "Batters (OF) - Bat X", _
        "Batters (SS) - Bat X", _
        "Batters (3B) - Bat X", _
        "Batters (2B) - Bat X") ' to easier check the spelling
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim dws As Worksheet: Set dws = wb.Sheets("Batters - Bat X")
    Dim dfCell As Range
    Set dfCell = dws.Cells(dws.Rows.Count, "A").End(xlUp).Offset(1)
    
    Dim sws As Worksheet, srg As Range, sLastRow As Long
    
    For Each sws In wb.Worksheets(swsNames)
        sLastRow = sws.Cells(sws.Rows.Count, "A").End(xlUp).Row
        Set srg = sws.Range("A2:D" & sLastRow)
        srg.Copy dfCell
        Set dfCell = dfCell.Offset(srg.Rows.Count)
    Next sws

    MsgBox "Columns copied.", vbInformation

End Sub