Sub Union()
Dim wBf As Workbook
Dim wB As Workbook

Set wB = ThisWorkbook
    For x = 1 To 2 'количество книг
      Set wBf = Workbooks("Книга" & x & ".xlsm")
        With wB.Sheets(1)
         iR = .Cells(Rows.Count, 1).End(xlUp).Row + 1
         iRx = wBf.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
            wBf.Sheets(1).Range("A2:Q" & iRx).Copy
         .Range("A" & iR).PasteSpecial (xlPasteAll)
        End With
    Next
End Sub

Sub обединить()
Dim iPath$, iFail$, aFail$, ps&
Dim otkuda As Range
Dim kuda As Range
Application.ScreenUpdating = False: Application.EnableEvents = False: Application.DisplayAlerts = False
iPath = "C:\Отчеты\" ' Папка где лежат файлы УКАЗАТЬ СВОЮ
iFail = Dir(iPath)
aFail = ActiveWorkbook.Name
Do While iFail <> ""
    Workbooks.Open Filename:=iPath & iFail
    ps = Range("A" & Rows.Count).End(xlUp).Row
    Set otkuda = Sheets("Лист1").Range("A2:Q" & ps)
    Windows(aFail).Activate
    ps = Range("A" & Rows.Count).End(xlUp).Row + 1
    Set kuda = Sheets("Лист1").Range("A" & ps)
    otkuda.Copy kuda
    Windows(iFail).Close
    iFail = Dir
Loop
Application.ScreenUpdating = True: Application.EnableEvents = True: Application.DisplayAlerts = True
End Sub