Sub PL01()
Dim eWorkbook, iWorkbook As Workbook
Set eWorkbook = ThisWorkbook
Dim eSheet As Worksheet
Dim i, z, t As Long
Dim iWorkbookImportOpen As Variant
Application.DisplayAlerts = False: Application.AskToUpdateLinks = False: Application.ScreenUpdating = False
' If ThisWorkbook.Worksheets.Count > 3 Then
' For t = ThisWorkbook.Worksheets.Count - 1 To 3 Step -1
' ThisWorkbook.Worksheets(t).Delete
' Next t
' End If
ChDir eWorkbook.Path
iWorkbookImportOpen = Application.GetOpenFilename(FileFilter:="Excel Workbooks (*.xlsx; *.xlsm; *.xls; *.xltm), *.xlsx; *.xlsm; *.xls; *.xltm", _
Title:="Select Import File", MultiSelect:=True)
On Error Resume Next
For i = LBound(iWorkbookImportOpen) To UBound(iWorkbookImportOpen)
Set iWorkbook = Workbooks.Open(Filename:=iWorkbookImportOpen(i), ReadOnly:=True)
iWorkbook.Worksheets(1).Activate
With iWorkbook.Worksheets(1)
Range(Cells(1, 1), Cells(iWorkbook.Worksheets(1).UsedRange.Rows.Count, iWorkbook.Worksheets(1).UsedRange.Columns.Count)).Copy
End With
iWorkbook.Application.WindowState = xlMinimized
eWorkbook.Activate
With eWorkbook
Set eSheet = .Worksheets.Add(After:=.Worksheets(2))
eSheet.Name = iWorkbook.Worksheets(1).Name
End With
With eWorkbook.ActiveSheet.Cells(1, 1): .PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False: End With
Application.CutCopyMode = False
iWorkbook.Close SaveChanges:=False
Next i
Application.DisplayAlerts = False: Application.AskToUpdateLinks = False: Application.ScreenUpdating = False: Application.Calculation = xlCalculationAutomatic
End Sub