Ошибка "Run-time error "9": Subscript out of range" - VB

Sub Загрузка данных из файлов()
    ' папка, в которой будет производиться поиск файлов DAT для обработки
    ПапкаДляФайлов$ = "E:\Data"
 
    Dim ErrorsArray    ' пустой массив для ошибок
 
    ' Считываем данные из всех файлов .DAT в папке в двумерный массив
    DataArr = DATfolder2Array(ПапкаДляФайлов$, 4, "", ErrorsArray)
 
    ' результаты выводим на листы "errors" и  "result" (они должны существовать)
    'Array2worksheet Worksheets("îøèáêè"), ErrorsArray, _
                    Array("Имя файла", "Номер строки, "Данные из строки")
    
    Array2worksheet Worksheets("ðåçóëüòГ*ГІ"), DataArr, _
                    Array("Столбец 1", "Столбец 2", "Столбец 3", "Столбец 4")
End Sub

Function DATfolder2Array(ByVal FolderPath$, ByVal ColumnsCount As Long, _
                         ByVal TextColumns$, ByRef ErrorsArr) As Variant
    ' получает путь FolderPath$ к папке с DAT-файлами
   ' считывает из файлов все строки, в которых число записей в строке равно ColumnsCount
   ' остальные (неподходящие) строки отправляет в массив ErrorsArr
   ' (столбцы ErrorsArr: 1-имя файла, 2 - номер строки, 3 - данные)
   ' в переменной TextColumns$ через запятую перечислены номера ТЕКСТОВЫХ столбцов
   ' Возвращает двумерный массив размером N*ColumnsCount
 
    ReDim ErrorsArr(1 To 1000, 1 To ColumnsCount + 2)
    On Error Resume Next
 
    Dim coll As New Collection, filename
    filename = Dir(FolderPath$ & "*.dat")
    While filename <> ""
        coll.Add filename    ' считываем в коллекцию coll нужные имена файлов
        filename = Dir
    Wend
 
    Dim newtxt As String, ro As String, errIndex As Long
    For Each filename In coll
        Application.StatusBar = "ГЋГЎГ°Г*ГЎГ*òûâГ*ГҐГІГ±Гї ГґГ*éë: " & filename
        newtxt = Split(ReadTXTfile(FolderPath$ & filename), vbLf, 2)(1)
        tempArr = "": tempArr = Split(newtxt, vbNewLine)
        For i = LBound(tempArr) To UBound(tempArr)
            ro = tempArr(i): ro = Replace(ro, vbTab, ";")
            If UBound(Split(ro, ";")) <> ColumnsCount - 1 And Len(Trim(ro)) > 0 Then
                tempArr(i) = "": errIndex = errIndex + 1
                ErrorsArr(errIndex, 1) = filename
                ErrorsArr(errIndex, 2) = "ÑòðîêГ* " & i + 1
                ErrorsArr(errIndex, 3) = ro
            End If
        Next i
        newtxt = Join(tempArr, vbNewLine)
        txt = txt & newtxt & vbNewLine: DoEvents
    Next
    While InStr(1, txt, vbNewLine & vbNewLine) > 0
        txt = Replace(txt, vbNewLine & vbNewLine, vbNewLine)
    Wend
 
    txt = Replace(txt, vbTab, ";"): tempArr = Split(txt, vbNewLine)
    ReDim newArr(1 To UBound(tempArr), 1 To ColumnsCount)
 
    For i = LBound(tempArr) To UBound(tempArr)
        roArr = "": roArr = Split(tempArr(i), ";")
        For j = 1 To ColumnsCount
            newArr(i + 1, j) = roArr(j - 1)
            If "," & TextColumns$ & "," Like "*," & j & ",*" Then
                newArr(i + 1, j) = "'" & newArr(i + 1, j)
            End If
        Next j
    Next i
    DATfolder2Array = newArr
    Application.StatusBar = False
End Function

Sub Array2worksheet(ByRef sh As Worksheet, ByVal arr, ByVal ColumnsNames)
    ' Получает двумерный массив Arr с данными,
   ' и массив заголовков столбцов ColumnsNames.
   ' Заносит данные из массива на лист sh
    
    If UBound(arr, 1) > sh.Rows.Count - 1 Or UBound(arr, 2) > sh.Columns.Count Then
        MsgBox "Массив не влезет на лист " & sh.Name, vbCritical, _
               "Размеры массива:  " & UBound(arr, 1) & "*" & UBound(arr, 2): End
    End If
    With sh
        .UsedRange.ClearContents
        ColumnsNamesCount = UBound(ColumnsNames) - LBound(ColumnsNames) + 1
        .Range("a1").Resize(, ColumnsNamesCount).Value = ColumnsNames
        .Range("a1").Resize(, ColumnsNamesCount).Interior.ColorIndex = 15
        .Range("a2").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
        '.UsedRange.EntireColumn.AutoFit
    End With
End Sub

Function ReadTXTfile(ByVal filename As String) As String
    Set fso = CreateObject("scripting.filesystemobject")
    Set ts = fso.OpenTextFile(filename, 1, True): ReadTXTfile = ts.ReadAll: ts.Close
    Set ts = Nothing: Set fso = Nothing
End Function

Function CombineArrays(Arr1 As Variant, Arr2 As Variant) As Variant
    'функция CombineArrays объединяет 2 двумерных массива ОДИНАКОВОЙ ШИРИНЫ в один массив
   '(второй массив "дописывается" ниже первого, путем добавления строк из второго массива в первый)
   'Функция возвращает массив той же ширины, что и исходные,
   'а вертикальная размерность возвращаемого массива равна сумме количества строк исходных массивов
   '
   'В случае, если один из массивов не задан, функция возвращает другой заданный массив (без изменений)
   'ВНИМАНИЕ: все размерности массивов 1 и 2 должны совпадать (кроме первой размерности - по высоте)
   'Подразумевается, что индексы массивов начинаются с 1 (директива Option Base 1)
 
    ' если один из параметров не является массивом, функция возвращает другой параметр (массив)
   If (Not IsArray(Arr1)) And IsArray(Arr2) Then CombineArrays = Arr2: Exit Function
    If (Not IsArray(Arr2)) And IsArray(Arr1) Then CombineArrays = Arr1: Exit Function
    ' если оба параметра функции не являются массивами
   If (Not IsArray(Arr2)) And (Not IsArray(Arr1)) Then
        Debug.Print "ОШИБКА: Оба переданных значения не являются массивами!"
        CombineArrays = Null: Exit Function
    End If
 
    ' проверяем совпадение размерностей массивов Arr1 и Arr2
   On Error Resume Next: Err.Clear
 
    If (LBound(Arr1, 2) <> LBound(Arr2, 2)) Or (UBound(Arr1, 2) <> UBound(Arr2, 2)) Then
        Debug.Print "ОШИБКА: Размерности массивов (по ширине) не совпадают"
        CombineArrays = Null: Exit Function
    End If
    If Err.Number = 9 Then
        Debug.Print "ОШИБКА: Один из массивов не является двумерным!"
        CombineArrays = Null: Exit Function
    End If
 
    ReDim arr(1 To UBound(Arr1, 1) + UBound(Arr2, 1), LBound(Arr1, 2) To UBound(Arr1, 2))
 
    For i = 1 To UBound(Arr1, 1)
        For j = LBound(Arr1, 2) To UBound(Arr1, 2)
            arr(i, j) = Arr1(i, j)
        Next
    Next
 
    For i = 1 To UBound(Arr2, 1)
        For j = LBound(Arr2, 2) To UBound(Arr2, 2)
            arr(i + UBound(Arr1, 1), j) = Arr2(i, j)
        Next
    Next
    CombineArrays = arr    ' возвращаем объединённый массив
End Function