I tried this macro but get a Runtime Error: -2147221080 (800401a8) Automation Error.
The debugger shows me the part with after and before. I tried to delete Before:=wb1.Sheets(1) but get another error at Set wb2 = Workbooks.Open(Ret5) and the macro opens alle files seperately not in the same sheet.
Can someone help me to fix this macro or with another macro.
Thank You !
The debugger shows me the part with after and before. I tried to delete Before:=wb1.Sheets(1) but get another error at Set wb2 = Workbooks.Open(Ret5) and the macro opens alle files seperately not in the same sheet.
Can someone help me to fix this macro or with another macro.
Thank You !
Code:
Sub ImportFiles()
Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook, wb4 As Workbook, wb5 As Workbook
Dim Ret1, Ret2, Ret3, Ret4, Ret5
Set wb1 = ActiveWorkbook
'~~> Get the first File
Ret1 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
, "Open File 1")
If Ret1 = False Then Exit Sub
'~~> Get the 2nd File
Ret2 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
, "Open File 2")
If Ret2 = False Then Exit Sub
'~~> Get the 3rd File
Ret3 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
, "Open File 3")
If Ret3 = False Then Exit Sub
'~~> Get the 4th File
Ret4 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
, "Open File 4")
If Ret4 = False Then Exit Sub
'~~> Get the 5th File
Ret5 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
, "Open File 5")
If Ret5 = False Then Exit Sub
'Change name and open workbooks
Set wb2 = Workbooks.Open(Ret1)
wb2.Sheets(1).copy Before:=wb1.Sheets(1)
ActiveSheet.Name = "File 1"
wb2.Close SaveChanges:=False
Set wb2 = Workbooks.Open(Ret2)
wb2.Sheets(1).copy After:=wb1.Sheets(1)
ActiveSheet.Name = "File 2"
wb2.Close SaveChanges:=False
Set wb2 = Workbooks.Open(Ret3)
wb2.Sheets(1).copy After:=wb1.Sheets(1)
ActiveSheet.Name = "File 3"
wb2.Close SaveChanges:=False
Set wb2 = Workbooks.Open(Ret4)
wb2.Sheets(1).copy After:=wb1.Sheets(1)
ActiveSheet.Name = "File 4"
wb2.Close SaveChanges:=False
Set wb2 = Workbooks.Open(Ret5)
wb2.Sheets(1).copy After:=wb1.Sheets(1)
ActiveSheet.Name = "File 5"
wb2.Close SaveChanges:=False
Set wb2 = Nothing
Set wb1 = Nothing
Set wb3 = Nothing
Set wb4 = Nothing
Set wb5 = Nothing
End Sub