Ez a makró összegyűjti, csak a jelzett sorban írd át az útvonalat.

Sub Osszevon()
    Const utvonal = "E:Alkönyvtár"    'Itt írd át az útvonalat
    Dim FN As String, WB As Workbook, usor As Long, gy_usor As Long
    
    ChDir utvonal
    FN = Dir(utvonal & "*.xls", vbNormal)
    Do
        If FN <> "." And FN <> ".." Then
            Workbooks.Open Filename:=FN
            usor = Cells(Rows.Count, "B").End(xlUp).Row
            Range(Cells(2, 2), Cells(usor, 2)).Copy
            
            ActiveWindow.ActivateNext
            gy_usor = Cells(Rows.Count, "B").End(xlUp).Row + 1
            Cells(gy_usor, 2).Select
            ActiveSheet.Paste
            
            ActiveWindow.ActivatePrevious
            ActiveWindow.Close
        End If
        FN = Dir()
    Loop Until FN = ""
End Sub