How to combine 2D arrays from multiple Excel files into single 2D array?-CodePudding

Target - to combine multiple 2D arrays from multiple Excel files into single 2D array. I'm first time in coding and VBA. Loop files is work. Loop 2D arrays don't work.

Sub RangeToArray()
Dim s As String, MyFiles As String
Dim i As Long, j As Long, r As Long, m As Long, n As Long
Dim dArray() As Variant, fArray() As Variant
Dim wb As Workbook, rng As Range

Application.DisplayAlerts = False
Application.ScreenUpdating = False

MyFiles = "C:\Users\User\Desktop\Nezavisimai\Papka2\"
s = Dir(MyFiles & "*.xls")
Do While s <> ""

    ReDim fArray(ubounddArray1, ubounddArray2)
    Set wb = Workbooks.Open(MyFiles & s, False, True)
    Set rng = wb.Sheets(1).Range("A1:B2")
        dArray = rng.Value
                
        uboundfArray1 = UBound(fArray, 1)
        uboundfArray2 = UBound(fArray, 2)
        ubounddArray1 = UBound(dArray, 1)
        ubounddArray2 = UBound(dArray, 2)

        ' Redim target array
        ReDim Preserve fArray(uboundfArray1, uboundfArray2   ubounddArray2   1)
                
        ' Add the values from the combined arrays
        For m = LBound(dArray, 1) To UBound(dArray, 1)      
            For n = LBound(dArray, 2) To UBound(dArray, 2)  
                fArray(m, uboundfArray2   n) = dArray(m, n)
            Next n
        Next m
                
                
    ' close Excel file                 
    wb.Close SaveChanges:=False
        
    s = Dir
        
Loop
    
    For i = 1 To UBound(fArray)
        For j = 1 To UBound(fArray)
            fArray(i, j) = Cells(i, j)
            Debug.Print (fArray(i, j)),
        Next j
       Debug.Print
    Next i
       
r = 8
With Worksheets("Insert").Range("A1")
    For Each Item In fArray
        .Cells(r, 1).Value = Item
        r = r   1
    Next Item
End With

Don't work. Write Run-time error '9': Subscript out of range.

CodePudding user response：

Untested, but this may be one way to approach it:

Sub RangeToArray()
    
    Dim s As String, MyFiles As String
    Dim fArray() As Variant, arr, i As Long
    Dim numRows As Long, numCols As Long, r As Long, c As Long, rT As Long
    Dim wb As Workbook, colArrays As Collection

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    MyFiles = "C:\Users\User\Desktop\Nezavisimai\Papka2\"
    s = Dir(MyFiles & "*.xls")
    Set colArrays = New Collection
    
    Do While s <> ""
        With Workbooks.Open(MyFiles & s, False, True)
            colArrays.Add .Sheets(1).Range("A1:B2").Value 'add array to collection
            .Close False
        End With
        s = Dir
    Loop
    
    numRows = UBound(colArrays(1), 1)
    numCols = UBound(colArrays(1), 2)  'edit:fixed typo

    ReDim fArray(1 To (numRows*colArrays.Count), 1 to numCols) 
    rT = 0
    'loop over collection and add each item to the final array
    For Each arr In colArrays
        For r = 1 To numRows
            rT = rT   1
            For c = 1 To numCols
                fArray(rT, c) = arr(r, c)
            Next c
        Next r
    Next arr
    
    Worksheets("Insert").Range("A1") _
          .Resize(UBound(fArray, 1), UBound(fArray, 2)).Value = fArray

End Sub