• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA to copy 5 workbooks into one workbook and rename the sheets

koskesh

Member
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 !

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
 
Koshkesh

This all works fine in Excel 2010 and 2013
Can you please explain what it is not doing and where it stops?
How are you running it ?
 
Hi Hui, thanks for the quick reply.
I'm running it on Excel 2010. It worked for the first two or three times. Then I copied the macro into another module and used it there. I get the error message that the workbook is already open (It isnt)
The part where I select the file works fine. It stops importing and renaming after the first sheet. (File 1)
The debugger shows the Runtime Error: -2147221080 (800401a8) Automation Error.
 
I changed the code a little bit. It works (no error) but its not 100% correct. The macro opens the first file but renames it as the last file and completely ignores the last file
Code:
Private Sub ImportFilesZwo()
  
  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*", _
  , "Opening Stock ZR141")
  If Ret1 = False Then Exit Sub
  '~~> Get the 2nd File
  Ret2 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
  , "Closing Stock aus ZR141")
  If Ret2 = False Then Exit Sub
  
  '~~> Get the 3rd File
  Ret3 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
  , "MB5B Opening Stock")
  If Ret3 = False Then Exit Sub
  
  '~~> Get the 4th File
  Ret4 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
  , "MB5B Closing Stock")
  If Ret4 = False Then Exit Sub
  
  '~~> Get the 5th File
  Ret5 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
  , "Masterdata")
  If Ret5 = False Then Exit Sub
  
  
  'Change name and open workbooks
  Set wb2 = Workbooks.Open(Ret1)
  wb2.Sheets(1).copy wb1.Sheets(1)
  ActiveSheet.Name = "ZR141 Opening Stock"
  wb2.Close SaveChanges:=False
  Set wb3 = Workbooks.Open(Ret2)
  wb3.Sheets(1).copy wb1.Sheets(2)
  ActiveSheet.Name = "ZR141 Closing Stock"
  wb3.Close SaveChanges:=False
  
  Set wb4 = Workbooks.Open(Ret3)
  wb4.Sheets(1).copy wb1.Sheets(3)
  ActiveSheet.Name = "MB5B Opening Stock"
  wb4.Close SaveChanges:=False
  
  Set wb5 = Workbooks.Open(Ret4)
  wb5.Sheets(1).copy wb1.Sheets(4)
  ActiveSheet.Name = "MB5B Closing Stock"
  wb5.Close SaveChanges:=False
  
  Set wb2 = Workbooks.Open(Ret5)
  wb2.Sheets(1).copy wb1.Sheets(5)
  ActiveSheet.Name = "Masterdata"
  wb2.Close SaveChanges:=False
  
  Set wb2 = Nothing
  Set wb3 = Nothing
  Set wb4 = Nothing
  Set wb5 = Nothing
  Set wb1 = Nothing
  
  End Sub
 
Shouldn't this section be:

Code:
'Change name and open workbooks  
  Set wb1 = Workbooks.Open(Ret1)
  wb1.Sheets(1).copy wb1.Sheets(1)
  ActiveSheet.Name = "ZR141 Opening Stock" 'Check name
  wb1.Close SaveChanges:=False
  
Set wb2 = Workbooks.Open(Ret2)
  wb2.Sheets(1).copy wb1.Sheets(2)
  ActiveSheet.Name = "ZR141 Closing Stock" 'Check name
  wb2.Close SaveChanges:=False
  
  Set wb3 = Workbooks.Open(Ret3)
  wb3.Sheets(1).copy wb1.Sheets(3)
  ActiveSheet.Name = "MB5B Opening Stock" 'Check name
  wb3.Close SaveChanges:=False
  
  Set wb4 = Workbooks.Open(Ret4)
  wb4.Sheets(1).copy wb1.Sheets(4)
  ActiveSheet.Name = "MB5B Closing Stock" 'Check name
  wb4.Close SaveChanges:=False
  
  Set wb5 = Workbooks.Open(Ret5)
  wb5.Sheets(1).copy wb1.Sheets(5)
  ActiveSheet.Name = "Masterdata" 'Check name
  wb5.Close SaveChanges:=False
 
Thanks Hui. I know what the issue was. I closed the initial active workbook wb1. That caused the error. I have a different issue now.

The script works. But the fifth file is exactly the same as the first, just with the correct name. I am not sure why.

Code:
Option Explicit
Sub ImportFiles()
    ChDrive "X"
    ChDir "X:\Makro Test"
     
    Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook, wb4 As Workbook, wb5 As Workbook, wb6 As Workbook
    Dim Ret1, Ret2, Ret3, Ret4, Ret5
 
    Set wb1 = ActiveWorkbook
 
    '~~> Get the first File
    Ret1 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
    , "Opening Stock ZR141")
    If Ret1 = False Then Exit Sub
 
    '~~> Get the 2nd File
    Ret2 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
    , "Closing Stock ZR141")
    If Ret2 = False Then Exit Sub
   
    '~~> Get the 3rd File
    Ret3 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
    , "MB5B Opening Stock")
    If Ret3 = False Then Exit Sub
   
        '~~> Get the 4th File
    Ret4 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
    , "MB5B Closing Stock")
    If Ret4 = False Then Exit Sub
   
          '~~> Get the 5th File
    Ret5 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
    , "Masterdata")
    If Ret5 = False Then Exit Sub
   
   
    'Change name and open workbooks
    Set wb1 = Workbooks.Open(Ret1)
    wb1.Sheets(1).copy wb1.Sheets(1)
    ActiveSheet.Name = "ZR141 Opening Stock"
       
    Set wb2 = Workbooks.Open(Ret2)
    wb2.Sheets(1).copy wb1.Sheets(2)
    ActiveSheet.Name = "ZR141 Closing Stock"
    wb2.Close savechanges:=False
 
    Set wb3 = Workbooks.Open(Ret3)
    wb3.Sheets(1).copy wb1.Sheets(3)
    ActiveSheet.Name = "MB5B Opening Stock"
    wb3.Close savechanges:=False
   
    Set wb4 = Workbooks.Open(Ret4)
    wb4.Sheets(1).copy wb1.Sheets(4)
    ActiveSheet.Name = "MB5B Closing Stock"
    wb4.Close savechanges:=False
   
    Set wb5 = Workbooks.Open(Ret5)
    wb5.Sheets(1).copy wb1.Sheets(5)
    ActiveSheet.Name = "Masterdata"
    wb5.Close savechanges:=False
     
    Set wb2 = Nothing
    Set wb3 = Nothing
    Set wb4 = Nothing
    Set wb5 = Nothing
    Set wb1 = Nothing
    Set wb6 = Nothing
   
  End Sub
 
Back
Top