objXls5.Sheets("Реестр").Range("A6:BE" & llastr).SpecialCells(12).Copy
objXls6.Sheets("Форма").Paste objXls6.Sheets("Форма").Range("B5")

If arr(счетчик, сводная_материал).Value = "Материал" Then

arr = objXls_Сводная.Sheets(лист_Сводная).Cells(1, 1).Resize(objXls_Сводная.UsedRange.Row + objXls_Сводная.UsedRange.Rows.Count - 1, objXls_Сводная.UsedRange.Column + objXls_Сводная.UsedRange.Columns.Count - 1).Value

i = 1
    тест_тайм = Time
    Dim массив_Сводная() As String
    ReDim массив_Сводная(1 To 18, 1 To i)
    For счетчик = начало_сводной To конец_сводной
        If objXls_Сводная.Sheets(лист_Сводная).Cells(счетчик, сводная_материал).Value = "Материал" Then
            массив_Сводная(1, i) = счетчик
            массив_Сводная(2, i) = objXls_Сводная.Sheets(лист_Сводная).Cells(счетчик, сводная_пид).Value
            массив_Сводная(3, i) = objXls_Сводная.Sheets(лист_Сводная).Cells(счетчик, сводная_номер_накладной).Value
            массив_Сводная(4, i) = objXls_Сводная.Sheets(лист_Сводная).Cells(счетчик, сводная_раздел).Value
            массив_Сводная(5, i) = objXls_Сводная.Sheets(лист_Сводная).Cells(счетчик, сводная_тэг).Value
            массив_Сводная(6, i) = objXls_Сводная.Sheets(лист_Сводная).Cells(счетчик, сводная_айдэнт).Value
            массив_Сводная(7, i) = objXls_Сводная.Sheets(лист_Сводная).Cells(счетчик, сводная_код_титула).Value
            массив_Сводная(8, i) = objXls_Сводная.Sheets(лист_Сводная).Cells(счетчик, сводная_наименование_объекта).Value
            массив_Сводная(9, i) = objXls_Сводная.Sheets(лист_Сводная).Cells(счетчик, сводная_шифр_рд).Value
            массив_Сводная(10, i) = objXls_Сводная.Sheets(лист_Сводная).Cells(счетчик, сводная_кратк_номенкл).Value
            массив_Сводная(11, i) = objXls_Сводная.Sheets(лист_Сводная).Cells(счетчик, сводная_проектн_наимен_мтр).Value
            массив_Сводная(12, i) = objXls_Сводная.Sheets(лист_Сводная).Cells(счетчик, сводная_гост_ту).Value
            массив_Сводная(13, i) = objXls_Сводная.Sheets(лист_Сводная).Cells(счетчик, сводная_ед_изм).Value
            массив_Сводная(14, i) = objXls_Сводная.Sheets(лист_Сводная).Cells(счетчик, сводная_количество).Value
            массив_Сводная(15, i) = objXls_Сводная.Sheets(лист_Сводная).Cells(счетчик, сводная_примеч).Value
            массив_Сводная(16, i) = objXls_Сводная.Sheets(лист_Сводная).Cells(счетчик, сводная_инф_по_сводн).Value
            массив_Сводная(17, i) = objXls_Сводная.Sheets(лист_Сводная).Cells(счетчик, сводная_отв).Value
            массив_Сводная(18, i) = objXls_Сводная.Sheets(лист_Сводная).Cells(счетчик, сводная_группа).Value
            i = i + 1
            ReDim Preserve массив_Сводная(1 To 18, 1 To i)
        End If
    Next счетчик
    тест_тайм2 = Time
    MsgBox Format(тест_тайм2 - тест_тайм, "hh:mm:ss")

команда = "SUBST X: ""\\lan\Архив новый\"""

Shell "C:\Windows\System32\cmd.exe /c " & команда

копия = "много получателей";
копия = копия + "еще кучка получателей";
Item.CC = копия

Sub Реестр()
    SourceFolder = "\\lan\Архив\"
    Set fso = CreateObject("scripting.filesystemobject")
    Set curfold = fso.GetFolder(SourceFolder)
    
    If Not curfold Is Nothing Then
        For Each sfol_1 In curfold.SubFolders
            If sfol_1.Name Like "*Линия*" Then
                For Each sfol_2 In sfol_1.SubFolders
                    If sfol_2.Name Like "L*" Then
                        For Each sfol_3 In sfol_2.SubFolders
                             If sfol_3.Name Like "*-D-*" Then
                                 For Each sfol_4 In sfol_3.SubFolders
                                     If sfol_4.Name Like "*утвержден*" Then
                                         For Each fil In sfol_4.Files
                                            If fil.Name Like "*-D-*" Then
                                                
                                                'добавление информации в реестр на основе найденного файла
                                                
                                             End If
                                         Next
                                     End If
                                 Next
                             End If
                        Next
                    End If
                Next
            End If
        Next
    End If
    Set fil = Nothing: Set curfold = Nothing: Set fso = Nothing

End Sub

objXls5.Sheets("Реестр").Range("A6:D" & llastr).SpecialCells(12).Copy
Sleep (400)
objXls6.Sheets("Форма").Paste objXls6.Sheets("Форма").Range("B" & llastr2)

objXls5.Sheets("Реестр").Range("A6:D" & llastr).SpecialCells(12).Copy objXls6.Sheets("Форма").Range("B" & llastr2)

objXls5.Sheets("Реестр").Range("W6:X" & llastr).SpecialCells(12).Copy

objXls6.Sheets("Форма").Paste objXls6.Sheets("Форма").Range("H" & llastr2)

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)

Sleep (400)

llastr = objXls.Sheets("Реестр").Cells(objXls.Sheets("Реестр").Rows.Count, 1).End(-4162).Row

    'запуск Excel
    On Error Resume Next
    Set objXls3 = GetObject(, "Excel.Application")
    If objXls3 Is Nothing Then Set objXls3 = CreateObject("Excel.Application")
    Set objXls2 = objXls3.Workbooks(имя_реестра)
    If objXls2 Is Nothing Then Set objXls2 = objXls3.Workbooks.Open(адрес_реестра)
    objXls2.Applicatio

objXls2.Sheets("Реестр").Cells(llastr, 51).Select

objXls2.Sheets("Реестр").Cells(llastr, 51).Value = дата_получения_письма