Copying multiple sheets to 1 workbook

rwitte

New Member
Joined
Mar 18, 2015
Messages
13
I am working on a macro that will take info from a list of machines and components for each machine.

Each machine refer to a "master" workbook that will be opened and sheet 1 (the only sheet in each workbook) will be copied to a new ("machine") workbook, each component also refers to its "master" and will be copied to a separate tab in the new machine workbook (there could be up to 20 components per machine).

The first time through, the code works correctly (the machine workbook is created with the first tab populated with the correct file).

When it goes back through to do the next column, I get a "Run-time error '9': Subscript out of range " error at "Sheets(1).Copy After:=Workbooks(wbName2).Sheets(0)" . Researching the error references a nonexistent array element.

Having very limited exposure to arrays, I do not know if using one would be the best approach for my current issue, how I would set it up and use it or what another workaround would consist of.

I am working with Excel 2016, any help would be appreciated.



Code:
Sub makeFiles3()
Dim lCol As Long
Dim lRow As Long
Dim wbName As String
Dim wbName2 As String   'name of new workbook- machine workbook
Dim MachName As String  'name of machine
Dim MastLoc As String   'Master Ledger Location
Dim ListLoc As String    'List Location
Dim ListNm As String    'List file Name
Dim filePath1 As String    'path used to open master file
Dim newTabName As String    'New Worksheet Name
Dim wbName3 As String   'name of new workbook- machine workbook without extension
Dim mySourceWB As Workbook  'this workook contains list of names
Dim myDestWB As Workbook    'New workbook name
Dim wkb As Workbook         'name of new workbook
Dim OtherWorkbook As Workbook         'machine level workbook

    lRow = Cells(Rows.Count, 1).End(xlUp).Row
    ListLoc = "C:\Users\T1738RW\Desktop\"
    ListNm = "machine ledger test.xlsm"
    MastLoc = "E:\master ledgers\"
'Adding New Workbook
    For i = 3 To 8
        MachName = Cells(i, 11).Value & "_" & Cells(i, 6).Value
        wbName = "E:\testRobotLedgers\" & MachName
        wbName2 = wbName & ".xlsx"
        wbName3 = MachName & ".xlsx"
        
'Saving the Workbook
                    Set mySourceWB = ActiveWorkbook
                    
                '   Build new file name based
                    
                    lCol = Cells(i, Columns.Count).End(xlToLeft).Column
                    
                    b = 0
                    For a = 17 To lCol
                    b = b + 1   ' sheet number
                    filePath1 = (MastLoc) & Cells(i, a).Value & ".xlsx"
                    
                    newTabName = Cells(i, a).Value
                        If b = 1 Then
                            
                            Workbooks.Open (filePath1)
                            Sheets(1).Copy
                            
                            ActiveWorkbook.SaveAs Filename:=wbName, FileFormat:=51
                            'ActiveWorkbook.SaveAs Filename:=wbName, FileFormat:=52 'format 52 = macro enabled wb
                            ActiveSheet.Name = newTabName
                            
                            ActiveWorkbook.Save
                            
                            Else
                                                       
                            Workbooks.Open (filePath1)
                            
                            'ThisWorkbook.Activate
                            
                            Sheets(1).Copy After:=Workbooks(wbName2).Sheets(0)
                            
                            'Sheets(1).Copy After:=Workbooks("E:\testRobotLedgers\BSLI_S01R01.xlsx").Sheets(Sheets.Count)
                            'Sheets(1).Activate
                            'Sheets(1).Copy
                            
                            'Sheets.Add After:=Workbooks("E:\testRobotLedgers\").Sheets(Sheets.Count)
                            ActiveSheet.Name = newTabName
                            ActiveWorkbook.Save
                            ActiveWorkbook.Close    'Close master Workbook
                            
                        End If
                            
                    Application.DisplayAlerts = False
                    ActiveWorkbook.Close    'Close wbName Workbook
                    ActiveWorkbook.Close    'Close master Workbook
                    
                    Application.DisplayAlerts = True
                    
                   
                   
                    Next a
    
        'ActiveWorkbook.Close
    Next i
    
End Sub
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
You're getting an error because there isn't such thing as sheet 0. The lowest sheet number is 1. Try the below instead.

Code:
With wkbName2
     Sheets(1).Copy After:=.Sheets(.Sheets.Count)
End With

You should qualify the workbook that Sheets(1) belongs to.
 
Last edited:
Upvote 0
Gaddy,

Thanks for your suggestion, when I attempt to use the above code, I get "Object required" error.
 
Upvote 0
Can you repost your entire code? You need to qualify the workbook name as mentioned earlier...
 
Upvote 0
Gaddy,

Here is the working code.

I found that:

The code "Sheets(1).Copy After:=Workbooks(wbName3).Sheets(Sheets.Count)" could not have the path and file name included (that was giving me out of range errors).
In order to list only the workbook name in the above code, I had to have the workbook, that I wanted to add the sheets to, be open prior to adding sheet (in this case wbname2), then I created another variable (wbName3) that only included the workbook name and extension (.xlsx).

Although, it is still somewhat "clunky", I was able to run a test over night and created 300 (3 to 7 worksheets each) files without issues.

Thanks for your time and insight (a different set of eyes with a new perspective helps more often than not).

Sub makeFiles4()
Dim lCol As Long 'last column used (in list)
Dim lRow As Long 'last row used (in list)
Dim wbName As String
Dim wbName2 As String 'name of new workbook- machine workbook
Dim MachName As String 'name of machine
Dim MastLoc As String 'Master Ledger Location
Dim ListLoc As String 'List Location
Dim ListNm As String 'List file Name
Dim filePath1 As String 'path used to open master file
Dim newTabName As String 'New Worksheet Name
Dim wbName3 As String 'name of new workbook- machine workbook without extension
Dim MastWB As String 'Temp register for master file name
Dim mySourceWB As Workbook 'this workook contains list of names
Dim myDestWB As Workbook 'New workbook name
Dim wkb As Workbook 'name of new workbook
Dim OtherWorkbook As Workbook 'machine level workbook
Application.ScreenUpdating = False
lRow = Cells(Rows.Count, 1).End(xlUp).Row ' counts rows that have values entered in column A


ListLoc = "C:\Users\T1738RW\Desktop" ' Location of spreadsheet that contains machines and components (this one)
ListNm = "machine ledger test.xlsm" ' This file

' location of master ledger file- these ledgers must have only one sheet and the naming convention must match
' the eventual sheets on the finished ledger.

MastLoc = "E:\master ledgers"
'Adding New Workbook
For i = 3 To lRow
MachName = Cells(i, 11).Value & "_" & Cells(i, 6).Value
wbName = "E:\testRobotLedgers" & MachName
wbName2 = wbName & ".xlsx"
wbName3 = MachName & ".xlsx"

'Saving the Workbook
Set mySourceWB = ActiveWorkbook

' Build new file name based

lCol = Cells(i, Columns.Count).End(xlToLeft).Column

b = 0
For a = 17 To lCol
b = b + 1 ' sheet number
filePath1 = (MastLoc) & Cells(i, a).Value & ".xlsx"

MastWB = Cells(i, a) & ".xlsx"

newTabName = Cells(i, a).Value
If b = 1 Then 'this section creates a new workbook for the machine and inserts 1st sheet (machine Ledger)

Workbooks.Open (filePath1)
Sheets(1).Copy

ActiveWorkbook.SaveAs Filename:=wbName, FileFormat:=51
'ActiveWorkbook.SaveAs Filename:=wbName, FileFormat:=52 'format 52 = macro enabled wb
ActiveSheet.Name = newTabName

ActiveWorkbook.Save
ActiveWorkbook.Close SaveChanges:=False 'Close mach Workbook
ActiveWorkbook.Close SaveChanges:=False 'Close master Workbook

Else 'This section creates new worksheets (tabs) in current workbook -- installs component ledgers -- and names tabs

Workbooks.Open (wbName2)

Workbooks.Open (filePath1)
Sheets(1).Copy After:=Workbooks(wbName3).Sheets(Sheets.Count)

Workbooks(MastWB).Close SaveChanges:=False

Workbooks(wbName3).Sheets(newTabName).Activate
ActiveSheet.Name = MachName & "_" & newTabName
ActiveWorkbook.Save
ActiveWorkbook.Close SaveChanges:=False

End If

Next a

Next i
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Hi,

I think you used the code I posted before I edited it. Scroll up and have another look.

I will take a look at your entire code later (this evening - UK), see if I can help tidy it up for you.
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,327
Members
452,635
Latest member
laura12345

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top