Option Explicit

Dim NewLine As Integer, Col As Integer, ToSheet As Worksheet
' Фукция поиска последней строки
Public Function LastRow(Optional ws As Worksheet, Optional FindRange As String) As Long
  If ws Is Nothing Then Set ws = ActiveSheet
  If FindRange = "" Then FindRange = Cells.Address
  LastRow = ws.Range(FindRange).Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
End Function

Sub RegularCopy(FName As String)
  Dim openwb As Workbook, FromSheet As Worksheet, FromRangeName As String, Lrow As Long, Frow As Long
  'Открытие исходной книги предполагается что файлы находятся по указанному адресу
  'Для работы макроса эту книгу запускаем через меню ФАЙЛ - Открыть книгу!
  Workbooks.Open Filename:="Z:\ZK\" & FName & ".XLS", UpdateLinks:=False
   Set openwb = ActiveWorkbook
  'переходим на лист с которого будут копироваться данные
   Set FromSheet = openwb.ActiveSheet
   'Имя Диапазона, в котором искать последнюю строку
   FromRangeName = Range(Cells( 1 ,  1 ).Address, Cells(Rows.Count, Col).Address).Address
   
   'первая строка в диапазоне, которую нужно копировать
   Frow =  2 
   'нахождение последней строки в диапазоне
   Lrow = LastRow(FromSheet, FromRangeName)
   
   'Копирование значений диапазона
   ToSheet.Range(Cells(NewLine,  1 ).Address, Cells(NewLine - Frow + Lrow, Col).Address).Value = _
   FromSheet.Range(Cells(Frow,  1 ).Address, Cells(Lrow, Col).Address).Value
   NewLine = NewLine - Frow + Lrow +  1 
   
  'закрытие книги
  openwb.Close False
End Sub

Sub Put_Data()
Dim openwb As Workbook
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
   
    '№ Последнего столбца для консолидации, первый считается "A".
    'Дейсвует как для исходных данных, так и для итоговых
   Col =  20 
    'Первая строка в которую заполняются значения
   NewLine =  2 
    'Книга в которую будем копировать
   Workbooks.Open Filename:="C:\15.XLSX", UpdateLinks:=False
    ''''''почему то без этой строчки нормально не работало
   Set openwb = ActiveWorkbook
    'Лист на который будем копировать
   Set ToSheet = openwb.Sheets("F")
    'Открытие листа куда заполняются данные
   ToSheet.Select
   'Очистка предыдущих данных
   Range(Cells(NewLine,  1 ), Cells(Rows.Count, Col)).Clear
   
     'Запуск процедуры копирования по каждому файлу, сколько угодно раз.
     'В кавычках имя файла без расширения

   RegularCopy ("2010_1_РТ_КРД_57350 - Запчасти")
   RegularCopy ("2010_1_РТ_КРД_57367 - Связь")
 
  Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic
 
End Sub