Az adatgyűjtésre (az utvonal változóban megadott mappában csak az összesítendő fájlok legyenek):

Sub Merge()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   
    Const utvonal = "E:EadatProba" 'Ide írd be a saját útvonaladat
    Dim fn As String
    Dim sz, elso, usor, uoszlop As Boolean
   
    ChDir utvonal
    fn = Dir(utvonal & "*.xls", vbNormal)
    sz = 0
    Do
        If fn <> "." And fn <> ".." Then
            If sz = 0 Then elso = 1 Else elso = 2 'Az első füzetnél a címsor is kell
       
            Workbooks.Open Filename:=fn
            Sheets("Adatok").Select  'A saját lapod nevét írd be
            usor = Range("A65536").End(xlUp).Row
            Range(Cells(elso, 1), Cells(usor, 5)).Copy
       
            ActiveWindow.ActivateNext   'Gyűjtő füzetre lépés
            If sz = 0 Then
                gy_usor = Range("A65536").End(xlUp).Row  'Gyüjtő füzet alsó sora
            Else
                gy_usor = Range("A65536").End(xlUp).Row + 1
            End If
           
            Cells(gy_usor, 1).Select
            ActiveSheet.Paste
       
            ActiveWindow.ActivatePrevious 'Behívott füzet
            ActiveWindow.Close
            sz = sz + 1
        End If
        fn = Dir()
    Loop Until fn = ""
   
    Range("A1").Select
    Application.ScreenUpdating = True
End Sub