Несколько файлов txt в excel

Нужна дополнительная помощь?

Sub ПримерИспользованияФункции_DATfolder2Array()
    Папка = "D:ПроектыDATs"    ' папка, в которой будет производиться поиск файлов DAT для обработки
    Dim ErrorsArray    ' пустой массив для ошибок

    ' считываем данные из все файлов .DAT в папке в двумерный массив
    DataArr = DATfolder2Array(Папка, 7, "1,2,4,5", ErrorsArray)
 
    ' результаты выводим на листы "errors" и "result" (они должны существовать)
    Array2worksheet Worksheets("errors"), ErrorsArray, _
                    Array("Имя файла", "Номер строки", "Данные из строки")
    Array2worksheet Worksheets("result"), DataArr, _
                    Array("Ячейка", "Штрих-Код", "Наименование", "код 1С", "код произв.", "кол-во", "счетовод")
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 = ReadTXTfile(FolderPath$ & filename)
        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

'---------------------------------------------------------------------------------------
' Author : Щербаков Дмитрий(The_Prist)
'          Профессиональная разработка приложений для MS Office любой сложности
'          Проведение тренингов по MS Excel
'          https://www.excel-vba.ru
'          info@excel-vba.ru
' Purpose: Процедура сбора данных с указанных текстовых файлов, оставляя только один заголовок
'---------------------------------------------------------------------------------------
Option Explicit
 
Sub Get_All_TXT_SkipHeader()
    Dim avFiles, li As Long, lHeadLinesCount As Long, lh As Long
    Dim objFSO As Object, objTxtFile As Object, sTxt, sAllTxt
    Dim IsSkipHeader As Boolean
    'диалог выбора текстовых файлов. Подробнее:
    '   https://www.excel-vba.ru/chto-umeet-excel/dialogovoe-okno-vybora-fajlovpapki/
    avFiles = Application.GetOpenFilename("TXT files(*.txt),*.txt,CSV files(*.csv),*.csv", , , , True)
    If VarType(avFiles) = vbBoolean Then Exit Sub
 
    IsSkipHeader = MsgBox("Оставлять только один заголовок(первого файла)?", vbQuestion + vbYesNo, "www.excel-vba.ru") = vbYes
    If IsSkipHeader Then
        lHeadLinesCount = Val(InputBox("Сколько строк в заголовке?", "www.excel-vba.ru", 1))
    End If
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    For li = LBound(avFiles) To UBound(avFiles)
        'открываем текстовый файл
        Set objTxtFile = objFSO.OpenTextFile(avFiles(li), 1)
        'если заголовок уже записан и указано оставлять только один заголовок
        'пропускаем строки заголовков для 2-го и последующих файлов
        If IsSkipHeader Then
            If li > LBound(avFiles) Then
                For lh = 1 To lHeadLinesCount
                    objTxtFile.skipline
                Next
            End If
        End If
        'считываем все данные файла
        sTxt = objTxtFile.ReadAll
        If sAllTxt = "" Then
            sAllTxt = sTxt
        Else
            sAllTxt = sAllTxt & sTxt
        End If
        'закрываем текстовый файл
        objTxtFile.Close
    Next li
    'создаем новый файл и записываем в него все считанные с файлов данные
    Set objTxtFile = objFSO.CreateTextFile("C:AllText.txt", True)
    objTxtFile.WriteLine sAllTxt
    objTxtFile.Close
    Set objTxtFile = Nothing
    Set objFSO = Nothing
End Sub