Почему я не мог просто прочитать листы и объединить все содержимое в один вариант?

Чтобы объединить массивы с одинаковым количеством столбцов, попробуйте следующий способ:

1. Объявите переменную поверх стандартного модуля (в области объявлений):

  Private arrFin()

3. Скопируйте следующий код в тот же стандартный модуль:

Sub TestMrgeArrays()
 Dim wb As Workbook, ws As Worksheet, lastRow As Long

 Set wb = ThisWorkbook
 For Each ws In wb.Worksheets ' Parse all the sheets
     lastRow = ws.cells(ws.rows.count, "A").End(xlUp).row ' find the last line of the sheet
     merge2DArrays ws.Range("A2:O" & lastRow).Value ' merge with the final one...
 Next ws
 Debug.Print UBound(arrFin), UBound(arrFin, 2): Stop
End Sub

Sub merge2DArrays(arr)
    Dim arrNew(), i As Long, j As Long, xF As Long
    
    If Not Not arrFin Then
        If UBound(arrFin, 2) <> UBound(arr, 2) Then MsgBox "Different number of columns...": Exit Sub
        ReDim arrNew(1 To UBound(arrFin) + UBound(arr), 1 To UBound(arrFin, 2))
        xF = UBound(arrFin)
        For i = 1 To UBound(arrNew)
            For j = 1 To UBound(arrNew, 2)
                If i <= xF Then
                    arrNew(i, j) = arrFin(i, j)
                Else
                    arrNew(i, j) = arr(i - xF, j)
                End If
            Next j
        Next i
        arrFin = arrNew
    Else
        arrFin = arr: Exit Sub
    End If
End Sub

Существует еще один вариант, включающий ReDim Preserve, который может взять предыдущий загруженный массив, транспонировать его и поместить содержимое в новый массив, загрузить его только содержимым нового массива и, наконец, уравнять окончательный массив с этим (временным). Но Transpose имеет некоторые ограничения с точки зрения размеров диапазона, и в вашем случае он не сработает. Я также могу выполнить транспонирование нестандартной функции без ошибок, но для этого также потребуется итерация...

Отредактировано:

В следующей версии используется зубчатый массив (массив массивов), который сначала загружается с каждым массивом листов и обрабатывается отдельной функцией:

Sub TestMrgeArrays_JGGArray()
 Dim wb As Workbook, ws As Worksheet, arrData() As Variant
 Dim lastRow, arrFin, iCount As Long, totCount As Long

 Set wb = ThisWorkbook
 ReDim arrData(wb.Worksheets.count - 1) 'ReDim it to keep all the sheets (0 based 1D array)
 For Each ws In wb.Worksheets ' Parse all the sheets
     lastRow = ws.cells(ws.rows.count, "A").End(xlUp).row ' find the last line of the sheet
     arrData(iCount) = ws.Range("A2:O" & lastRow).Value ' place it in the jagged array
     iCount = iCount + 1:  totCount = totCount + lastRow - 1 ' -1 because the array is loaded from the second row...
 Next ws
 arrFin = MergeShArrays(arrData, totCount)
 Debug.Print UBound(arrFin), UBound(arrFin, 2): Stop
End Sub

Function MergeShArrays(arrD, totCount As Long) As Variant
  Dim i As Long, j As Long, k As Long, iRow As Long, colNo As Long, arr, arrNew()
  colNo = UBound(arrD(0), 2)
  ReDim arr(1 To totCount, 1 To colNo)
  For i = 0 To UBound(arrD)
    arrNew = arrD(i)
    For j = 1 To UBound(arrNew)
        iRow = iRow + 1
        For k = 1 To colNo
            arr(iRow, k) = arrNew(j, k)
        Next k
    Next j
  Next i
  MergeShArrays = arr
End Function

Должно быть немного быстрее определение общего количества строк из итерационной части листов.

Вы можете прочитать значения диапазона в переменной Variant. Если диапазон содержит только одну ячейку, вариант получит это значение. Если диапазон содержит более одной ячейки, вариант будет представлять собой двумерный массив.

Назначением этого чтения должен быть вариант. Это не может быть предопределенный массив:

ReDim a(1 To 10, 1 To 15) 
' This will give a runtime error 13 (Type mismatch)
a = ThisWorkbook.Sheets(1).Range("A1:O10").Value

Dim b()
' This will give a runtime error 13 (Type mismatch)
b = ThisWorkbook.Sheets(1).Range("A1:O10").Value

Dim c As Variant
' Only this is okay:
c = ThisWorkbook.Sheets(1).Range("A1:O10").Value

И, как следствие, вы не можете считать данные диапазона в часть предопределенного массива (за исключением случаев, когда диапазон содержит только одну ячейку).

Так что если вам действительно нужен один большой массив, содержащий все данные всех листов, вам нужно создать этот массив самостоятельно.

Следующий код будет считывать данные каждого листа отдельно в коллекцию двумерных массивов. Во время чтения подсчитывается общий размер.

Когда чтение завершено, мы знаем, насколько большим должен быть конечный массив. Создается массив, и в него копируются все данные лист за листом, значение за значением.

Dim ws As Worksheet
Dim Data As New Collection
Dim totalRows As Long

' Step 1: Read data of every sheet into separate arrays
For Each ws In ThisWorkbook.Worksheets ' Parse all the sheets

    Dim lastSheetLine As Long
    lastSheetLine = ws.Cells(ws.Rows.Count, "A").End(xlUp).row ' find the last line of the sheet
    Data.Add ws.Range("A2:O" & lastSheetLine).Value, ws.Name
    totalRows = totalRows + (lastSheetLine - 1)
Next

' Step 2: Now Copy all data into one big array
ReDim AllInOneData(1 To totalRows, 1 To 15)
Dim allInOneRow As Long, sheetIndex As Long, row As Long, col As Long
For sheetIndex = 1 To Data.Count
    For row = 1 To UBound(Data(sheetIndex), 1)
        allInOneRow = allInOneRow + 1
        For col = 1 To UBound(Data(sheetIndex), 2)
            AllInOneData(allInOneRow, col) = Data(sheetIndex)(row, col)
        Next col
    Next row
Next sheetIndex

Обратите внимание, что вам не нужно писать Worksheets(ws.name).Cells, если ws уже является рабочим листом. Просто напишите ws.Cells.

Альтернатива использованию новых функций динамических массивов

Вместо чтения всех элементов нескольких массивов в общий массив этот подход

• добавляет только формулы динамического диапазона на лист (например, =A2:O100000) в скрытый временный лист и
• назначает динамические блоки в общий массив data за один раз.

Поскольку это решение сводит к минимуму взаимодействие между прямыми табличными вычислениями Excel и VBA (не говоря уже о циклах по строкам), оно должно получить выгоду от хорошего или даже лучшего поведения во времени.

Sub MrgArrays()
Const firstRow = 2, firstCol = "A", lastCol = "O"
'0) define array of needed sheets (or choose empty array for ALL sheets)
    Dim SheetNames As Variant
    SheetNames = Array("Tabelle1", "Tabelle3") '<< define only needed sheets
'1) use temporary worksheet
    Dim temp As Worksheet
    Set temp = getTempSheet(ClearIt:=True)
'2) get individual sheet data address
    Dim nxt As Long: nxt = firstRow         ' start temp sheet row counter
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Sheets(SheetNames)
    'a) find last sheet row
        Dim lastRow As Long
        lastRow = ws.cells(ws.Rows.Count, "A").End(xlUp).Row
        If ws.Name = temp.Name Then lastRow = 0
    'b) define next sheet address & add further dynamic formula to temp sheet
        Dim addr As String
        If lastRow >= firstRow Then
            'define next sheet address
            addr = firstCol & firstRow & ":" & lastCol & lastRow
            'add dynamic formula to temporary sheet
            temp.Range("A" & nxt).Formula2 = " = " & ws.Range(addr).Address(external:=True)
            'increment nxt
            nxt = nxt + lastRow - firstRow + 1
        End If
    Next
'3) build total array of temp sheet data
    lastRow = temp.cells(temp.Rows.Count, "A").End(xlUp).Row
    Dim data As Variant
    data = temp.Range(firstCol & firstRow & ":" & lastCol & lastRow).Value2
End Sub

Вспомогательная функция getTempSheet() (спасибо @funthomas)

Function getTempSheet(Optional wsName As String = "TEMP", _
    Optional ByVal ClearIt As Boolean = False, _
    Optional ByVal HideIt As Boolean = True) As Worksheet
'Site: https://stackoverflow.com/questions/76719083/populate-a-listbox-with-two-tables/76721164#76721164
'Auth: https://stackoverflow.com/users/7599798/funthomas
'Note: adapted 2024-06-28 by T.M. (https://stackoverflow.com/users/6460297/t-m)
'Purp: Create the helper sheet if it is not present.
    On Error Resume Next
    Set getTempSheet = ThisWorkbook.Sheets(wsName)
    On Error GoTo 0                 ' referenced sheet is not present
    If getTempSheet Is Nothing Then
        ThisWorkbook.Sheets.Add
        Set getTempSheet = ActiveSheet
        getTempSheet.Name = wsName
    End If
    ' optional code lines
    If ClearIt Then getTempSheet.cells.Clear                
    getTempSheet.Visible = IIf(HideIt, xlSheetHidden, xlSheetVisible)
End Function

Получить данные со всех листов

Приложение

Sub GetDataFromAllSheetsTEST()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim Data As Variant: Data = GetDataFromAllSheets(wb, , True)
    If IsEmpty(Data) Then Exit Sub
    
    ' Continue working with the data...
    
End Sub

Вспомогательная функция

Function GetDataFromAllSheets( _
    ByVal wb As Workbook, _
    Optional ByVal HeaderRowsCount As Long = 1, _
    Optional ByVal DisplayMessages As Boolean = False) _
As Variant
    Const PROC_TITLE As String = "Get Data From All Sheets"
    
    ' Validate number of worksheets.
    
    Dim iwCount As Long: iwCount = wb.Worksheets.Count
    If iwCount = 0 Then
        If DisplayMessages Then
            MsgBox "No worksheets found in " _
                & IIf(Len(wb.Path) = 0, "the never saved ", "") _
                & "workbook """ & wb.Name & """" _
                & IIf(Len(wb.Path) = 0, "", " located in """ & wb.Path & """") _
                & "!", vbExclamation, PROC_TITLE
        End If
        Exit Function
    End If
    
    ' Loop through the worksheets to create a reference to each range
    ' in the 1st column and return the number of rows in the 2nd column
    ' of the Worksheets Data array ('wsData').
    
    Dim wsData() As Variant: ReDim wsData(1 To iwCount, 1 To 2)
    
    Dim ws As Worksheet, rg As Range, wCount As Long
    Dim srCount As Long, cCount As Long, trCount As Long, tcCount As Long
    Dim IsColumnsCountDetermined As Boolean, IsNoDataInSheet As Boolean
    
    For Each ws In wb.Worksheets
        ' Assuming the list starts in 'A1' with no empty rows or columns.
        With ws.Range("A1").CurrentRegion
            srCount = .Rows.Count - HeaderRowsCount
            If srCount > 0 Then
                Set rg = .Resize(srCount).Offset(HeaderRowsCount)
                cCount = .Columns.Count
            Else
                IsNoDataInSheet = True
            End If
        End With
        If IsNoDataInSheet Then
            IsNoDataInSheet = False
        Else
            If Not IsColumnsCountDetermined Then
                tcCount = cCount
                IsColumnsCountDetermined = True
            End If
            If cCount <> tcCount Then
                MsgBox "The number of columns is different in worksheet """ _
                    & ws.Name & """!", vbExclamation, PROC_TITLE
                Exit Function
            End If
            wCount = wCount + 1
            Set wsData(wCount, 1) = rg
            wsData(wCount, 2) = srCount
            trCount = trCount + srCount
        End If
    Next ws
        
    ' Validate the number of worksheets with data (ranges).
    
    If wCount = 0 Then
        If DisplayMessages Then
            MsgBox "No data found in " _
                & IIf(Len(wb.Path) = 0, "the never saved ", "") _
                & "workbook """ & wb.Name & """" _
                & IIf(Len(wb.Path) = 0, "", " located in """ & wb.Path & """") _
                & "!", vbExclamation, PROC_TITLE
        End If
        Exit Function
    End If
    
    ' Loop through the Worksheets Data array and return the values
    ' from each range in the resulting Total array ('tData').
    
    Dim tData() As Variant: ReDim tData(1 To trCount, 1 To tcCount)
    
    Dim sData() As Variant, w As Long, sr As Long, tr As Long, c As Long
    
    For w = 1 To wCount
        srCount = wsData(w, 2)
        If srCount + cCount = 2 Then
            ReDim sData(1 To 1, 1 To 1): sData(1, 1) = wsData(w, 1).Value
        Else
            sData = wsData(w, 1).Value
        End If
        For sr = 1 To srCount
            tr = tr + 1
            For c = 1 To tcCount
                tData(tr, c) = sData(sr, c)
            Next c
        Next sr
    Next w
    
    GetDataFromAllSheets = tData
    
    If DisplayMessages Then
        MsgBox "Retrieved data from " & wCount & "(out of " & iwCount _
            & ") worksheet" & IIf(iwCount = 1, "", "s") & "." & vbLf & vbLf _
            & "Number of rows: " & trCount & vbLf _
            & "Number of columns: " & tcCount, vbInformation, PROC_TITLE
    End If
    
End Function