Sub AllFiles666()
Application.DisplayAlerts = False
Application.EnableCancelKey = xlDisabled
Dim folderPath As String
Dim Filename As String
Dim wb As Workbook
Dim sh As Worksheet
folderPath = "C:\Users\marti\OneDrive\Plocha\ZDROJ" 'contains folder path
If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"
Filename = Dir(folderPath & "*.xlsx")
Do While Filename <> ""
Application.ScreenUpdating = False
Set wb = Workbooks.Open(folderPath & Filename)
Range("A1:AA" & Range("A" & Rows.Count).End(xlUp).Row).Copy
'Not working well here as it will be overwritten by the next file
Workbooks("POKUS.xlsm").Worksheets("List1").Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteValues
Workbooks(Filename).Close
Filename = Dir
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Subcitovat