Sub XML_BASE_LOADING()
   On Error Resume Next
 
  Dim cBook As Workbook
  Dim csheet As Worksheet
  Dim STSHEET As Worksheet
  Dim CLCSHEET As Worksheet
  
  
  Dim PWay, coll As Collection
  Dim I_COUNTER As Integer
  Dim J_COUNTER As Integer
  Dim FNAME As String
  Dim FLAG As Boolean
  Dim DB As Workbook
  Dim WS As Worksheet
  Dim k As Integer
  Dim logstr As String
  
  
  ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  

Set cBook = ThisWorkbook
Set STSHEET = cBook.Worksheets(STOP_sheet)
Set CLCSHEET = cBook.Worksheets(CALC_SHEET)

 Application.DisplayAlerts = False
J_COUNTER = 1

'---------------------------------------------------------------------------------------------------
' Так как  приложение запускает несколько раз, то на листе STSHEET хранятся имена 
' уже обработанных файлов, дабы избежать задвоений при работе
 
    For Each FILE In coll
          FNAME = Mid(FILE, InStrRev(FILE, "\") + 1)
          I_COUNTER = 2
          FLAG = True
 
         
        Do While Len(STSHEET.Cells(I_COUNTER, 1)) <> 0
                If STSHEET.Cells(I_COUNTER, 1).Value = FNAME Then
                    FLAG = False
                End If
                I_COUNTER = I_COUNTER + 1
        Loop

' Если файл еще не был обработан и мы обработали меньше    Limit_max (после которых Эксель вешает машину), то 
' открываем его для работы

        If FLAG And J_COUNTER <= Limit_max Then
                STSHEET.Cells(I_COUNTER, 1) = FNAME
                CLCSHEET.Range("A1:Z65000").Clear
                Set DB = Workbooks.Open(FILE)

 ' проверяем наличие в *xml-файле нужного нам листа            
  
                For Each WS In DB.Sheets
                        If WS.Cells(1, 1) = "/Данные" Then
                            I_COUNTER = 1

                            Do While Len(WS.Cells(2, I_COUNTER)) <> 0
                           
                                 ' В случае успеха копируем столбцы - для удобства убрал  
                                
                                I_COUNTER = I_COUNTER + 1
                                 
                            Loop
                            cBook.Activate
                            I_COUNTER = 3
                           ' нахожу кол-во строк, необходимых к копрованию
                            Do While Len(CLCSHEET.Cells(I_COUNTER, 7)) <> 0
                                I_COUNTER = I_COUNTER + 1
                            Loop

                            Open target_file For Append As #1
                            
                            For k = 3 To I_COUNTER - 1
                                logstr = CLCSHEET.Cells(k, 1)                                                                 
                                Print #1, logstr
                            Next
                            Close #1
                            
                            
                        End If
                
                Next
                J_COUNTER = J_COUNTER + 1
                DB.Close
                Set DB = Nothing
                
                
        End If
          
    Next
   Application.DisplayAlerts = True
   
 
End Sub

Set DB = Workbooks.Open(FILE)

  For Each FILE In coll
           
          FNAME = Mid(FILE, InStrRev(FILE, "\") + 1)
          I_COUNTER = 2
          FLAG = True
          
        Do While Len(STSHEET.Cells(I_COUNTER, 1)) <> 0
                If STSHEET.Cells(I_COUNTER, 1).Value = FNAME Then
                    FLAG = False
                End If
                I_COUNTER = I_COUNTER + 1
        Loop
        
        If FLAG And J_COUNTER <= Limit_max Then
                STSHEET.Cells(I_COUNTER, 1) = FNAME
                
                Set newBook = Workbooks.Add
                
                Set CLCSHEET = newBook.Worksheets.Add
                CLCSHEET.Name = CALC_SHEET
                            
                Set DB = Workbooks.Open(FILE)
                
             

                J_COUNTER = J_COUNTER + 1
                DB.Close 0
                newBook.Close 0
                Set newBook = Nothing
                Set CLCSHEET = Nothing
                Set DB = Nothing
                Set WS = Nothing
                logstr = ""
                FNAME = ""
                              
                
        End If
          
    Next
   Application.DisplayAlerts = True
   
   
End Sub