Application.ScreenUpdating = False

  Dim i, i1, i2, t As Long
  Dim j As Long, n As Long
  Dim sheet As Worksheet
  Dim Nazvanie As String
  Dim Nm(8) As String
  Dim ShtNm(8) As String
  Dim NewWB As Workbook
  Dim s, Ssum As Long
   
   
  Ssum = 10 'Количество пустых строк определяющее конец листа
   
  Nazvanie = "Общий прайс" 'Вписать название листа, на который будет выводиться информация
    
  pathNWB = ActiveWorkbook.Path & "\" 'Общий путь
  nameNWB = "Общий прайс.xlsx"
   
           MsgBox (pathNWB)
   
Set NewWB = Workbooks.Add

NewWB.Worksheets(1).Name = "Общий прайс"

Nm(1) = pathNWB & "ABB" & "\" & "ABB.xlsx"
Nm(2) = pathNWB & "DKC" & "\" & "DKC.xls"
Nm(3) = pathNWB & "EKF" & "\" & "EKF.xlsx"
Nm(4) = pathNWB & "IEK" & "\" & "IEK.xlsx"
Nm(5) = pathNWB & "Legrand" & "\" & "Legrand.xls"
Nm(6) = pathNWB & "SE_DEKraft" & "\" & "SE_DEKraft.xlsm"
Nm(7) = pathNWB & "Rittal" & "\" & "rittal.xls"

ShtNm(1) = "НОВЫЙ"
ShtNm(2) = "Прайс ДКС"
ShtNm(3) = "Продукция EKF electrotechnica"
ShtNm(4) = "1"
ShtNm(5) = "ТАРИФ"
ShtNm(6) = "Tariff_Moscow"
ShtNm(7) = "Price_list_34_10"

For n = 1 To 7
  If n = 1 Then
  k = 1
  Else
  k = 0
  End If

Workbooks.Open Nm(n)

  For t = 1 To ActiveWorkbook.Worksheets.Count
     
  If ActiveWorkbook.Worksheets(t).Name = ShtNm(n) Then
    i = 2 - k
    Do
    i = i + 1

    If IsEmpty(ActiveWorkbook.Worksheets(t).Cells(i + 1, 1)) = True Then
     
    For s = 0 To Ssum 'ищем выражение, образованное соединением значений 10 ячеек, следующих после i-й ячейки
    sumCell = sumCell & ActiveWorkbook.Worksheets(t).Cells(i + 1 + s, 1).Value
    Next s
    End If
     
    Loop While Not sumCell = "0" 'поднимаем номер строки до тех пор, пока выражение из 10 строк не будет равно ""
    sumCell = "0"
    j = 21

    i1 = 0
    Do
    i1 = i1 + 1
     
    Loop While Not IsEmpty(NewWB.Worksheets(1).Cells(i1, 1)) = True
    ActiveWorkbook.Worksheets(t).Cells(2 - k, 1).Resize(i, 21).Copy NewWB.Worksheets(1).Cells(i1, 1)
     

  End If

  Next t

Next n

    i1 = 1
    Do
    i1 = i1 + 1
    Loop While Not IsEmpty(NewWB.Worksheets(1).Cells(i1, 1)) = True

    NewWB.Activate
    ActiveWorkbook.Worksheets(1).Cells(1, 1).Resize(i1, 21).Select
       Selection.RowHeight = 15
      With Selection.Borders(xlEdgeLeft)
         .LineStyle = xlContinuous
         .ColorIndex = 0
         .TintAndShade = 0
         .Weight = xlThin
     End With
      
Application.DisplayAlerts = False
NewWB.SaveAs Filename:=pathNB & "1_" & nameNWB
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub