Sub LoopFilesAlko22()
    Dim myFSO As Object, myFolder As Object, myFile As Object
    Dim sh_act As Worksheet, rng_res As Range, res()
    Dim bk As Workbook, Sh As Worksheet
    Dim arr(), r As Long, i As Long, j As Long
    Dim ИМЯКНИГИ As String
    Dim ИМЯЭТОЙКНИГИ As String
    Dim KodV As Variant
    Dim myF As Range
    Dim shFroml As Worksheet
  ИМЯЭТОЙКНИГИ = ActiveWorkbook.name ' ЭТО Я ТЕСТИРУЮ.
  a = Cells.Find("*контра*").Offset(0, 1).Address
  Range(a) = LTrim(RTrim((Range(a))))
 
' ВОТ ЭТА ПЕРЕМЕННАЯ "contract" , КОГДА ДЕЛО ДОХОДИТ ДО 92 строки: If LCase(myFile.name) Like "LT_*" Then
   Set contract = Cells.Find("*контра*").Offset(0, 1) ' объявляем контракт, со здвигом сразу правее на одну ячейку

    ' Откл. монитора.
    Application.DisplayAlerts = False
    
    '3. Создание объекта для работы с папками и файлами.
    Set myFSO = CreateObject(Class:="Scripting.FileSystemObject")
    
    '4. Создание ссылки на папку, в которой находятся инвойсы.
        ' Путь определяется по активному файлу.
    Set myFolder = myFSO.GetFolder(ActiveWorkbook.Path)
    
    '5. Проверка, что нужные файлы не открыты, чтобы не было непредвиденных ситуаций.
        ' Открытым будет только один инвойс, который будет активным.
    For Each myFile In myFolder.Files
        For Each bk In Workbooks
            If bk.FullName <> ActiveWorkbook.FullName Then
                If bk.name = myFile.name Then
                    Application.ScreenUpdating = True
                    MsgBox "Закройте файлы, которые находятся в новой папке." & vbCr & _
                        "Открытым должен быть только один инвойс из новой папки.", vbExclamation
                    Exit Sub
                End If
            End If
        Next bk
    Next myFile
    
'---------------------------------------------------------------------------------------------------------------------
    '6. Сбор информации.
        ' Если в каком-то иновойсе в "G3" не пусто, значит макрос нужно остановить,
        ' т.к. работа уже была сделана.
     ' =========================================================================================
     ' ПОВТОР ПО-НОВОЙ
    '3) Извлечение данных из закрытых инвойсов.
    For Each myFile In myFolder.Files
     ИМЯКНИГИ = ActiveWorkbook.name
     ActiveWorkbook.Save
     
        ' Активный файл пропускаем.
        If myFile.name = ActiveWorkbook.name Then
      
             ' Следующий инвойс.
            
            GoTo metka_NextFile
            
        End If
        
        ' Скрытые файлы пропускаем.
        If (GetAttr(myFile.Path) And vbHidden) <> 0 Then
            GoTo metka_NextFile
        End If
            
        ' Смотрим расширение.
        If Not LCase(myFile.name) Like "*.xls*" Then
            GoTo metka_NextFile
        End If
        ' Смотрим спецификацию.
        If LCase(myFile.name) Like "*specifikacija*" Then
         GoTo metka_NextFile
        End If
        'определяем еслить ли лист в книге, если нет,- следующий файл:
         d = "инвойс"
         On Error Resume Next
         Set wsSheet = Sheets(d)
         If Err.number <> 0 Then
         ActiveWindow.Close savechanges:=False
         GoTo metka_NextFile
         End If
        ' Определяем с каким листом будем работать: отказ: итак буду на етом листе находится!
        'If ActiveSheet.name = "спецификация" Then  только эту строчку коментим,- ниже влияет на всё!
        '========================================================================================
        ' походу из=за этого момента пременная contract теряет свое значание
         If LCase(myFile.name) Like "LT_*" Then
           Set Sh = Workbooks.Open(filename:=myFile.Path, ReadOnly:=False).Worksheets("инвойс")
           Else
         Set Sh = Workbooks.Open(filename:=myFile.Path, ReadOnly:=False).Worksheets("спецификация")
         End If
         '========================================================================================
        
        
'         If ActiveWorkbook.Sheets.count = 1 Then
'         Set Sh = Workbooks.Open(filename:=myFile.Path, ReadOnly:=False).Worksheets("инвойс")
'         If ActiveWorkbook.Sheets.count > 1 Then
'          Set Sh = Workbooks.Open(filename:=myFile.Path, ReadOnly:=False).Worksheets("спецификация")
'         d = "спецификация"
'         On Error Resume Next
'         Set wsSheet = Sheets(d)
'         If Err.number <> 0 Then
'         ActiveWindow.Close savechanges:=False
'         GoTo metka_NextFile
'         End If
           
           'End If
        Sh.Activate
         'определяем еслить ли лист в книге, если нет,- следующий файл:
         d = "инвойс"
         On Error Resume Next
         Set wsSheet = Sheets(d)
         If Err.number <> 0 Then
         ActiveWindow.Close savechanges:=False
         GoTo metka_NextFile
         End If
        ' метка есть- пропускаем файл
        If ActiveSheet.Range("B5").Interior.Color = 16115929 Then
        GoTo metka_NextFile
        End If

        
        ' если метки нету,- , можно с файлом работать!
        If ActiveSheet.Range("B5").Interior.Color <> 16115929 Then
        'MsgBox "это он"
        ' ==========================================================================
        '        '========================================
        'тема контрактов: ПОКА НЕ ЗНАЮ КУДА СТВИТЬ ЭТУ 
        ' удоление лишних пробелов вначале и конце  контракта:
          b = Cells.Find("*контра*").Offset(0, 1).Address
          Range(b) = LTrim(RTrim((Range(b))))
          'определяем номер контракта нового инвойса
         Set contractt = Cells.Find("*контра*").Offset(0, 1) ' объявляем контракт, со здвигом сразу правее на одну ячейку
         ' проверяем контракты:
         If contract <> contractt Then 'если номера контрактов несовпадают, - пропускаем это файл
    

         MsgBox "эти контракты несопасдают:" & contract & contractt

        ' Stop
         ActiveWindow.Close savechanges:=False
         GoTo metka_NextFile
         End If

'
'        '========================================
        
          Windows(ИМЯКНИГИ).Close savechanges:=True
          ' ЗАКРЫВАЕМ ВСЕ ОТКРЫТЫЕ КНИГИ, КРОМЕ АКТИВНОЙ.
          CloseAllWorkbooks_Save ' игоряшин макрос)))))
          
     
        End If

metka_NextFile:
    Next myFile
    Application.ScreenUpdating = True
  ' =========================================================================================
     ' КОНЕЦ ПОВТОРА ПО-НОВОЙ
' удоляем лишние листы в мастер-инвойсе, между активным листом и последним:
' в остальных видах товаров я сам макрос не буду копирувать, только запуск.
DeleteRightSheets
'metka_N:
End Sub