Sub mac1()
Dim pth As FileDialogSelectedItems
Dim curwb As Workbook
Dim wb As Workbook
Dim ls As Double
Dim lLastRow As Double
Set curwb = ActiveWorkbook
ls = 1
With Application.FileDialog(msoFileDialogFilePicker)
.Filters.Clear
.Filters.Add "Microsoft Excel files", "*.xls?"
.AllowMultiSelect = True
.InitialFileName = ThisWorkbook.Path
If .Show = 0 Then Exit Sub
Set pth = .SelectedItems
End With
For Each Name In pth
Set wb = Workbooks.Open(Name)
For Each List In wb.Worksheets
If List.FilterMode = True Then List.ShowAllData
lLastRow = List.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To lLastRow + 1
For j = 1 To List.UsedRange.Columns.Count
List.Range(List.Cells(i, j), List.Cells(i, j)).Copy (curwb.Worksheets(1).Range(curwb.Worksheets(1).Cells(ls + i - 1, j)))
Next j
Next i
ls = ls + lLastRow
Next
wb.Close (False)
Next
End Sub

List.Range(List.Cells(i, j), List.Cells(i, j)).Copy (curwb.Worksheets(1).Range(curwb.Worksheets(1).Cells(ls + i - 1, j)))