For Each Filename In coll

            Set FSO = CreateObject("Scripting.FileSystemObject")
    Set file = FSO.GetFile(Filename)
    Set TextStream = file.OpenAsTextStream(1)
        TextStream.SkipLine 'Переходим на второую строку
        arr = Split(TextStream.ReadLine(), vbTab) 'Читаем строку в массив, разделитель Tab
        SN = arr(65) 'Из 65 столбца узнаем Серийный номер
        TextStream.Close

        'Создаём новый лист, с имя=серйник, если такого листа ещё нет
        Dim wsSh As Worksheet
        On Error Resume Next
        Set wsSh = Sheets(SN)
        If wsSh Is Nothing Then
            Sheets.Add(, Sheets(Sheets.Count)).Name = SN

    For Each Filename In coll

         With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Filename, Destination:=Range("a" & ActiveSheet.Rows.Count).End(xlUp).Offset(1))
        .Name = "Values_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1251
        .TextFileStartRow = 2
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(9, 1, 9, 1, 1, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 1, 9, 9, 9, 9, _
        9, 9, 9, 9, 1, 9, 9, 9, 9, 9, 9, 9, 9, 1, 9, 9, 9, 9, 9, 9, 9, 9, 1, 9, 1, 1, 9)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
         
    Next

For Each Filename In coll 'Колеекция которая содержит пути к импортируемым файлам

        ' открываем очередной файл в режиме «только чтение»
        Set WB = Nothing: Set WB = Workbooks.Open(Filename, False, True)

        Set sh = WB.Worksheets(1)    ' будем брать данные с первого листа
            
            Dim InsertColumns 'Массив импортируемых столбцов
            InsertColumns = Array("B", "D", "E", "U", "AH", "AU", "BH", "BL", "BN") 'Берем столбцы B,D,E,U,AH,AU,BH,BL,BN
            Dim TargerColumns 'Массив столбцов в которые будем вставлять
            TargerColumns = Array("A", "B", "C", "D", "E", "F", "G", "H", "I") 'Вставляем в столбцы A,B,C,D,E,F,G,H,I
            
            Dim i As Integer
            Dim StartRange
            For i = LBound(InsertColumns) To UBound(InsertColumns)
            StartRange = InsertColumns(i) & "2" 'Забираем данные начиная с второй строки

            Set Column = sh.Range(sh.Range(StartRange), sh.Range(InsertColumns(i) & sh.Rows.Count).End(xlUp))
            '=========== переносим данные в наш файл (shd - кодовое имя листа, куда помещаем данные)
            shd.Range(TargerColumns(i) & shd.Rows.Count).End(xlUp).Offset(1).Resize(Column.Rows.Count, Column.Columns.Count).Value = Column.Value

            Next i

    For Each Filename In coll
        pi.SubAction "обрабатываем файл $index из $count", "Файл": " & Dir(Filename), "$time"
        pi.Log "Файл": " & Dir(Filename)
   
        Set WB = Nothing: Set WB = Workbooks.Open(Filename, False, True)

            pi.Log vbTab & "Ошибка при загрузке файла. Файл не обработан"

        Else   
            Set sh = WB.Worksheets(1)               

 'Время
 Set b = sh.Range(sh.Range("B2"  ;)  , sh.Range("B" & sh.Rows.Count).End(xlUp))
 shd.Range("a" & shd.Rows.Count).End(xlUp).Offset(1).Resize(b.Rows.Count, b.Columns.Count).Value = b.Value
 
 'Расход
 Set D = sh.Range(sh.Range("D2"  ;)  , sh.Range("D" & sh.Rows.Count).End(xlUp))
 shd.Range("B" & shd.Rows.Count).End(xlUp).Offset(1).Resize(D.Rows.Count, D.Columns.Count).Value = D.Value
 
 'Код АЦП
 Set E = sh.Range(sh.Range("E2"  ;)  , sh.Range("E" & sh.Rows.Count).End(xlUp))
 shd.Range("C" & shd.Rows.Count).End(xlUp).Offset(1).Resize(E.Rows.Count, E.Columns.Count).Value = E.Value
 
 ' МЧСИ1
 Set U = sh.Range(sh.Range("U2"  ;)  , sh.Range("U" & sh.Rows.Count).End(xlUp))
 shd.Range("D" & shd.Rows.Count).End(xlUp).Offset(1).Resize(U.Rows.Count, U.Columns.Count).Value = U.Value
 
 ' МЧСИ2
 Set AH = sh.Range(sh.Range("AH2"  ;)  , sh.Range("AH" & sh.Rows.Count).End(xlUp))
 shd.Range("E" & shd.Rows.Count).End(xlUp).Offset(1).Resize(AH.Rows.Count, AH.Columns.Count).Value = AH.Value
 
 ' МЧСИ3
 Set AU = sh.Range(sh.Range("AU2"  ;)  , sh.Range("AU" & sh.Rows.Count).End(xlUp))
 shd.Range("F" & shd.Rows.Count).End(xlUp).Offset(1).Resize(AU.Rows.Count, AU.Columns.Count).Value = AU.Value
 
 ' МЧСИ4
 Set BH = sh.Range(sh.Range("BH2"  ;)  , sh.Range("BH" & sh.Rows.Count).End(xlUp))
 shd.Range("G" & shd.Rows.Count).End(xlUp).Offset(1).Resize(BH.Rows.Count, BH.Columns.Count).Value = BH.Value
 
 'Ток катушки
 Set BL = sh.Range(sh.Range("BL2"  ;)  , sh.Range("BL" & sh.Rows.Count).End(xlUp))
 shd.Range("H" & shd.Rows.Count).End(xlUp).Offset(1).Resize(BL.Rows.Count, BL.Columns.Count).Value = BL.Value
 
 'Серийный№
 Set BN = sh.Range(sh.Range("BN2"  ;)  , sh.Range("BN" & sh.Rows.Count).End(xlUp))
 shd.Range("I" & shd.Rows.Count).End(xlUp).Offset(1).Resize(BN.Rows.Count, BN.Columns.Count).Value = BN.Value
 
 ' ==== конец обработки данных из очередного файла

 WB.Close False: DoEvents ' закрываем обработанный файл без сохранения изменений

 Sub Macro1()

 With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\Temp\Test.tsv", _
 Destination:=Range("$A$1"  ;)  )
 .Name = "Test"
 .FieldNames = True
 .RowNumbers = False
 .FillAdjacentFormulas = False
 .PreserveFormatting = True
 .RefreshOnFileOpen = False
 .RefreshStyle = xlInsertDeleteCells
 .SavePassword = False
 .SaveData = True
 .AdjustColumnWidth = True
 .RefreshPeriod = 0
 .TextFilePromptOnRefresh = False
 .TextFilePlatform = 850
 .TextFileStartRow = 1
 .TextFileParseType = xlDelimited
 .TextFileTextQualifier = xlTextQualifierDoubleQuote
 .TextFileConsecutiveDelimiter = False
 .TextFileTabDelimiter = True
 .TextFileSemicolonDelimiter = False
 .TextFileCommaDelimiter = False
 .TextFileSpaceDelimiter = False
 .TextFileColumnDataTypes = Array(1, 9, 9, 1)
 .TextFileTrailingMinusNumbers = True
 .Refresh BackgroundQuery:=False
 End With
End Sub

                 
'======Берем столбцы B,D,E,U,AH,AU,BH,BL,BN
' ==== переносим данные в наш файл (shd - кодовое имя листа, куда помещаем данные)
Set b = sh.Range(sh.Range("B2"), sh.Range("B" & sh.Rows.Count).End(xlUp))
shd.Range("a" & shd.Rows.Count).End(xlUp).Offset(1).Resize(b.Rows.Count, b.Columns.Count).Value = b.Value
           
Set D = sh.Range(sh.Range("D2"), sh.Range("D" & sh.Rows.Count).End(xlUp))
shd.Range("B" & shd.Rows.Count).End(xlUp).Offset(1).Resize(D.Rows.Count, D.Columns.Count).Value = D.Value
            
Set E = sh.Range(sh.Range("E2"), sh.Range("E" & sh.Rows.Count).End(xlUp))
shd.Range("C" & shd.Rows.Count).End(xlUp).Offset(1).Resize(E.Rows.Count, E.Columns.Count).Value = E.Value
            
Set U = sh.Range(sh.Range("U2"), sh.Range("U" & sh.Rows.Count).End(xlUp))
shd.Range("D" & shd.Rows.Count).End(xlUp).Offset(1).Resize(U.Rows.Count, U.Columns.Count).Value = U.Value
            
Set AH = sh.Range(sh.Range("AH2"), sh.Range("AH" & sh.Rows.Count).End(xlUp))
shd.Range("E" & shd.Rows.Count).End(xlUp).Offset(1).Resize(AH.Rows.Count, AH.Columns.Count).Value = AH.Value
           
Set AU = sh.Range(sh.Range("AU2"), sh.Range("AU" & sh.Rows.Count).End(xlUp))
shd.Range("F" & shd.Rows.Count).End(xlUp).Offset(1).Resize(AU.Rows.Count, AU.Columns.Count).Value = AU.Value
            
Set BH = sh.Range(sh.Range("BH2"), sh.Range("BH" & sh.Rows.Count).End(xlUp))
shd.Range("G" & shd.Rows.Count).End(xlUp).Offset(1).Resize(BH.Rows.Count, BH.Columns.Count).Value = BH.Value
           
Set BL = sh.Range(sh.Range("BL2"), sh.Range("BL" & sh.Rows.Count).End(xlUp))
shd.Range("H" & shd.Rows.Count).End(xlUp).Offset(1).Resize(BL.Rows.Count, BL.Columns.Count).Value = BL.Value
            
Set BN = sh.Range(sh.Range("BN2"), sh.Range("BN" & sh.Rows.Count).End(xlUp))
shd.Range("I" & shd.Rows.Count).End(xlUp).Offset(1).Resize(BN.Rows.Count, BN.Columns.Count).Value = BN.Value