Объединение файлов + подсчет строк

'Количество строк во всех объединяемых файлах:
Dim N
'Динамические массивы для временного хранения данных ячеек:
Dim B(), C(), D(), E(), F(), G()

'ПРОЦЕДУРА GetData ИЗВЛЕКАЕТ ДАННЫЕ ИЗ УКАЗАННОГО ФАЙЛА
Sub GetData(WorkbookName)
  'В файле перебираем строки:
  For I = 2 To Workbooks(WorkbookName).Sheets("список").Rows.Count
    'Извлекаем из строки данные ячеек:
    Value1 = Workbooks(WorkbookName).Sheets("список").Cells(I, 2)
    Value2 = Workbooks(WorkbookName).Sheets("список").Cells(I, 3)
    Value3 = Workbooks(WorkbookName).Sheets("список").Cells(I, 4)
    Value4 = Workbooks(WorkbookName).Sheets("список").Cells(I, 5)
    Value5 = Workbooks(WorkbookName).Sheets("список").Cells(I, 6)
    'Если везде оказалось пусто - выходим из цикла:
    If IsEmpty(Value1) And IsEmpty(Value2) _
    And IsEmpty(Value3) And IsEmpty(Value4) And IsEmpty(Value5) _
    Then Exit For
    'Увеличиваем N:
    N = N + 1
    'Расширяем массивы:
    ReDim Preserve B(1 To N)
    ReDim Preserve C(1 To N)
    ReDim Preserve D(1 To N)
    ReDim Preserve E(1 To N)
    ReDim Preserve F(1 To N)
    'Записываем данные в массивы:
    B(N) = Value1
    C(N) = Value2
    D(N) = Value3
    E(N) = Value4
    F(N) = Value5
  Next
  'Конец цикла
End Sub
'КОНЕЦ ПРОЦЕДУРЫ GetData

'ПРОЦЕДУРА GetCount СЧИТАЕТ КОЛИЧЕСТВО ПОВТОРОВ
Sub GetCount()
  'Расширяем массив:
  ReDim G(1 To N)
  'Сравниваем каждую строку со всеми остальными,
  'записываем количество повторов:
  For I = 1 To N
    G(I) = 1
    For K = 1 To N
      If I <> K _
      And B(I) = B(K) _
      And C(I) = C(K) _
      And D(I) = D(K) _
      And E(I) = E(K) _
      Then G(I) = G(I) + 1
    Next K
  Next I
  'Всё записали
End Sub
'КОНЕЦ ПРОЦЕДУРЫ GetCount

'ПРОЦЕДУРА SetData ЗАПИСЫВАЕТ МАССИВЫ В ФАЙЛ
Sub SetData()
  'Заполняем в цикле строки:
  For I = 1 To N
    ActiveWorkbook.Sheets("свод").Cells(I + 1, 2) = B(I)
    ActiveWorkbook.Sheets("свод").Cells(I + 1, 3) = C(I)
    ActiveWorkbook.Sheets("свод").Cells(I + 1, 4) = D(I)
    ActiveWorkbook.Sheets("свод").Cells(I + 1, 5) = E(I)
    ActiveWorkbook.Sheets("свод").Cells(I + 1, 6) = F(I)
    ActiveWorkbook.Sheets("свод").Cells(I + 1, 7) = G(I)
  Next
  'Конец цикла
End Sub
'КОНЕЦ ПРОЦЕДУРЫ SetData

'ПРОЦЕДУРА Tables ОБЪЕДИНЯЕТ ФАЙЛЫ
Sub Tables()
  N = 0
  'Определяем путь к активной книге Excel:
  Path = Left(ActiveWorkbook.FullName, _
              Len(ActiveWorkbook.FullName) - Len(ActiveWorkbook.Name))
  'Открываем файлы, которые будем объединять:
  Workbooks.Open Path & "1xxx.xls"
  Workbooks.Open Path & "2xxx.xls"
  Workbooks.Open Path & "3xxx.xls"
  'Заполняем массивы:
  GetData ("1xxx.xls")
  GetData ("2xxx.xls")
  GetData ("3xxx.xls")
  'Закрываем файлы:
  Workbooks("1xxx.xls").Close
  Workbooks("2xxx.xls").Close
  Workbooks("3xxx.xls").Close
  'Считаем повторы:
  GetCount
  'Записываем данные:
  SetData
End Sub
'КОНЕЦ ПРОЦЕДУРЫ Tables

'ПРОЦЕДУРА Tables ОБЪЕДИНЯЕТ ФАЙЛЫ
Sub Tables()
Dim oAwb As String, oFile
  N = 0
  'очищаем лист
  Intersect(ActiveSheet.UsedRange, Rows("2:65536"), Columns("B:G")).ClearContents
  'выбираем файлы
  With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .InitialFileName = "*.xls"
        .Title = "Выберите файлы"
        If .Show = False Then Exit Sub
        For Each oFile In .SelectedItems
            Workbooks.OpenText Filename:=oFile
            oAwb = Dir(oFile, vbDirectory)

            Application.ScreenUpdating = False
            Workbooks(oAwb).Activate
            GetData (oAwb)
 
            Workbooks(oAwb).Close False
        Next oFile
    End With
   GetCount
   SetData
End Sub
'КОНЕЦ ПРОЦЕДУРЫ Tables

Select
Таблица1.Поле1,Таблица1.Поле2,
Таблица2.Поле1,Таблица2.Поле2,Таблица2.Поле3
From Таблица1,Таблица2