x = 4
a = ActiveWorkbook.Path
 
 
Dim fs, f, f1, fc, vdummy
    Dim vPfad As String
 
    vPfad = a & "\User\"
 
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(vPfad)
    Set fc = f.Files
 
    For Each f1 In fc
 
        Set vdummy = Workbooks.Open(vPfad & f1.Name)
        For i = 5 To vdummy.Sheets(1).Cells.SpecialCells(xlCellTypeLastCell).Row
            vdummy.Sheets(1).Rows(i).Copy
 
        ThisWorkbook.Sheets(1).Range("A" & x).PasteSpecial xlValue
        x = x + 1
        Next i
        vdummy.Saved = True
        vdummy.Close
    Next