Copy multiple sheets to new workbook using dynamic array

[zmasterdevil]

Hello Everyone,

When I click a button on a sheet within my workbook, I want a macro to do the following:

1. Copy all the sheets named in cell “AA1” to a new workbook (I’m having trouble getting a dynamic array to work for this). If the array needs each sheet name in a different cell, I can put the sheet names in “AA1”, “AB1”, “AC1”, etc…
2. Then save the new workbook into the Documents folder using data from 2 cells on the active sheet (“Z2”, & “AA2”) to name the file. Cell “Z2” is the account number, and cell “AA2” is the month/year of the workbook in format “mmmm yyyy” (this is NOT the current month/year).
3. Then close the new workbook.

I am not sure if the array part is possible, or if there is another way to go about this. I am trying to create a code that will work for each group of worksheets that need to be saved together. But if a dynamic array or something similar won't work, I will make do with the rest of the code working, and I'll just hard code in the sheet names for each account grouping and make multiple modules to accomplish it (I'm trying to avoid making so many repetitive modules if possible).

I've put my code below. I keep getting a "Run-time Error '9': Subscript out of range" (I've attached a screenshot of where the debugger stops on the "Sheets(Array(Range("AA1").Value)).Copy" line. I've looked up a lot of information on arrays, but haven't found anything that works for what I'm trying to do.

I welcome any help, or suggestions of other ways to accomplish my aim if using an array for this won't work. Apologies for any coding blunders, I do not know much VBA code.

Sub Copy_Sheets_to_New_Workbook()

    Dim FilePath As String
    Dim FileExt As String
    Dim FileName As String
    Dim FileFullPath As String
    Dim FileFormat As Variant
    Dim wb1 As Workbook
    Dim wb2 As Workbook

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
            
    Set wb1 = ThisWorkbook
        Sheets(Array(Range("AA1").Value)).Copy
    Set wb2 = ActiveWorkbook
    
        'Below gets the File Extension and File Format
    With wb2
        If Val(Application.Version) < 12 Then
             FileExt = ".xls": FileFormat = -4143
        Else
            Select Case wb1.FileFormat
            Case 51: FileExt = ".xlsx": FileFormat = 51
            Case 52:
                If .HasVBProject Then
                    FileExt = ".xlsm": FileFormat = 52
                Else
                    FileExt = ".xlsx": FileFormat = 51
                End If
            Case 56: FileExt = ".xls": FileFormat = 56
            Case Else: FileExt = ".xlsb": FileFormat = 50
            End Select
        End If
    End With
    
        'Save workbook in Documents folder of your system
    FilePath = "C:\Users\JAMES\Documents"
    
        'Now append month/year to the filename
    FileName = Range("Z2").Value & " " & Range("AA2").Value  'Possibly change 2nd cell to: Format(Range("AA2").Value), "mmmm yyyy")
    
        'Complete path of the file where it is saved
    FileFullPath = FilePath & FileName & FileExt
    
        'Now save currect workbook at the above path
    wb2.SaveAs FileFullPath, FileFormat:=FileFormat
    
    wb2.Close SaveChanges:=True

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

 

[OaklandJim]

You say that the value in cell AA1 contains the names of worksheets to include in a new workbook. That is fine if there is a comma between the sheet names. VBA can be used to get a list of sheet names. Also, what if there is a name listed in AA1 for which there is no sheet in the source workbook?

This seems doable. I'll try to help if I have a copy of your workbook. Use the link icon above to post a link to your workbook using Dropbox or 1Drive.

If data is too sensitive then you can provide the workbook with fake data.

 

[Herakles]

This works for me.

Tested except I don't have a C:\Users\JAMES\Documents\ folder.

You will just need to change this line to include your worksheet name.
It is always good to set an object to the sheet referred to later in the code.
Set WsActive = Worksheets("Destination")

No checking that the sheets actually exist has been carried out.

Public Sub subCopySheetsToNewWorkbook()
Dim Wb As Workbook
Dim WbActive As Workbook
Dim WsActive As Worksheet

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    ActiveWorkbook.Save
    
    Set WbActive = ActiveWorkbook
    
    ' Set the active sheet.
    Set WsActive = Worksheets("Destination")
    
    WsActive.Activate
    
    ' Create an array from the worksheet names.
    ' Copying these worksheets automatically creates a new workbook and copies
    ' the worksheets to that workbook. No others sheets exist in the new workbook.
    WbActive.Sheets(Split(WsActive.Range("AA1"), ",")).Copy
    
    ActiveWorkbook
        .SaveAs Filename:="C:\Users\JAMES\Documents\" & WsActive.Range("Z2").Value & "-" & WsActive.Range("AA2").Value, FileFormat:=WbActive.FileFormat
        .Close
    End With
        
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
    MsgBox "Done"
    
End Sub

 

[zmasterdevil]

You say that the value in cell AA1 contains the names of worksheets to include in a new workbook. That is fine if there is a comma between the sheet names. VBA can be used to get a list of sheet names. Also, what if there is a name listed in AA1 for which there is no sheet in the source workbook?

This seems doable. I'll try to help if I have a copy of your workbook. Use the link icon above to post a link to your workbook using Dropbox or 1Drive.

If data is too sensitive then you can provide the workbook with fake data.

Hi OaklandJim,

I appreciate any help you can give me with this.

Link to Test Workbook I'm not sure if this link will work, as it's on my company's OneDrive. If it doesn't work, I will set up a personal One Drive and upload it there.

I input all the data in the "AA1" cells, so if for some reason it is missing/incorrect, I will fix it right away. I've deleted all identifying info from the workbook (that's why it looks so empty).

 

[zmasterdevil]

This works for me.

Tested except I don't have a C:\Users\JAMES\Documents\ folder.

You will just need to change this line to include your worksheet name.
It is always good to set an object to the sheet referred to later in the code.
Set WsActive = Worksheets("Destination")

No checking that the sheets actually exist has been carried out.

Public Sub subCopySheetsToNewWorkbook()
Dim Wb As Workbook
Dim WbActive As Workbook
Dim WsActive As Worksheet

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
  
    ActiveWorkbook.Save
  
    Set WbActive = ActiveWorkbook
  
    ' Set the active sheet.
    Set WsActive = Worksheets("Destination")
  
    WsActive.Activate
  
    ' Create an array from the worksheet names.
    ' Copying these worksheets automatically creates a new workbook and copies
    ' the worksheets to that workbook. No others sheets exist in the new workbook.
    WbActive.Sheets(Split(WsActive.Range("AA1"), ",")).Copy
  
    ActiveWorkbook
        .SaveAs Filename:="C:\Users\JAMES\Documents\" & WsActive.Range("Z2").Value & "-" & WsActive.Range("AA2").Value, FileFormat:=WbActive.FileFormat
        .Close
    End With
      
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
  
    MsgBox "Done"
  
End Sub

Hi Herakles,

Thank you for trying to help me with this issue. I copied your code and tried to run it, first without changing anything, then after changing "Destination" to the name of the sheet I was running it from. I get a compile error saying invalid use of property. I've attached screen caps below. And it's highlighting the "Public Sub" line. Do i need to edit this line first? Sorry if any of this is obvious to others, but I have yet to get a good handle on VBA coding.

Herakles​

 

[OaklandJim]

The link takes me to a screen for AlliedUniversal.

 

[Herakles]

This works for me.

Tested except I don't have a C:\Users\JAMES\Documents\ folder.

You will just need to change this line to include your worksheet name.
It is always good to set an object to the sheet referred to later in the code.
Set WsActive = Worksheets("Destination")

No checking that the sheets actually exist has been carried out.

Public Sub subCopySheetsToNewWorkbook()
Dim Wb As Workbook
Dim WbActive As Workbook
Dim WsActive As Worksheet

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
   
    ActiveWorkbook.Save
   
    Set WbActive = ActiveWorkbook
   
    ' Set the active sheet.
    Set WsActive = Worksheets("Destination")
   
    WsActive.Activate
   
    ' Create an array from the worksheet names.
    ' Copying these worksheets automatically creates a new workbook and copies
    ' the worksheets to that workbook. No others sheets exist in the new workbook.
    WbActive.Sheets(Split(WsActive.Range("AA1"), ",")).Copy
   
    ActiveWorkbook
        .SaveAs Filename:="C:\Users\JAMES\Documents\" & WsActive.Range("Z2").Value & "-" & WsActive.Range("AA2").Value, FileFormat:=WbActive.FileFormat
        .Close
    End With
       
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
   
    MsgBox "Done"
   
End Sub

I've noticed an ommission in this code so use this instead.

Public Sub subCopySheetsToNewWorkbook()
Dim Wb As Workbook
Dim WbActive As Workbook
Dim WsActive As Worksheet

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    ActiveWorkbook.Save
    
    Set WbActive = ActiveWorkbook
    
    ' Set the active sheet.
    Set WsActive = Worksheets("Destination")
    
    WsActive.Activate
    
    ' Create an array from the worksheet names.
    ' Copying these worksheets automatically creates a new workbook and copies
    ' the worksheets to that workbook. No others sheets exist in the new workbook.
    WbActive.Sheets(Split(WsActive.Range("AA1"), ",")).Copy
    
    With ActiveWorkbook
        .SaveAs Filename:="C:\Users\JAMES\Documents\" & WsActive.Range("Z2").Value & "-" & WsActive.Range("AA2").Value, FileFormat:=WbActive.FileFormat
        .Close
    End With
        
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
    MsgBox "Done"
    
End Sub

 

[Herakles]

Hi Herakles,

Thank you for trying to help me with this issue. I copied your code and tried to run it, first without changing anything, then after changing "Destination" to the name of the sheet I was running it from. I get a compile error saying invalid use of property. I've attached screen caps below. And it's highlighting the "Public Sub" line. Do i need to edit this line first? Sorry if any of this is obvious to others, but I have yet to get a good handle on VBA coding.

Herakles​

I've just noticed this quite independently. Apologises for that.

Public Sub subCopySheetsToNewWorkbook()
Dim Wb As Workbook
Dim WbActive As Workbook
Dim WsActive As Worksheet

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    ActiveWorkbook.Save
    
    Set WbActive = ActiveWorkbook
    
    ' Set the active sheet.
    Set WsActive = Worksheets("Destination")
    
    WsActive.Activate
    
    ' Create an array from the worksheet names.
    ' Copying these worksheets automatically creates a new workbook and copies
    ' the worksheets to that workbook. No others sheets exist in the new workbook.
    WbActive.Sheets(Split(WsActive.Range("AA1"), ",")).Copy
    
    WIth ActiveWorkbook
        .SaveAs Filename:="C:\Users\JAMES\Documents\" & WsActive.Range("Z2").Value & "-" & WsActive.Range("AA2").Value, FileFormat:=WbActive.FileFormat
        .Close
    End With
        
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
    MsgBox "Done"
    
End Sub

 

[zmasterdevil]

The link takes me to a screen for AlliedUniversal.

Hi OaklandJim, I've created a personal account and uploaded the workbook there. Link below:
Test Workbook

 

[zmasterdevil]

I've just noticed this quite independently. Apologises for that.

Public Sub subCopySheetsToNewWorkbook()
Dim Wb As Workbook
Dim WbActive As Workbook
Dim WsActive As Worksheet

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
   
    ActiveWorkbook.Save
   
    Set WbActive = ActiveWorkbook
   
    ' Set the active sheet.
    Set WsActive = Worksheets("Destination")
   
    WsActive.Activate
   
    ' Create an array from the worksheet names.
    ' Copying these worksheets automatically creates a new workbook and copies
    ' the worksheets to that workbook. No others sheets exist in the new workbook.
    WbActive.Sheets(Split(WsActive.Range("AA1"), ",")).Copy
   
    WIth ActiveWorkbook
        .SaveAs Filename:="C:\Users\JAMES\Documents\" & WsActive.Range("Z2").Value & "-" & WsActive.Range("AA2").Value, FileFormat:=WbActive.FileFormat
        .Close
    End With
       
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
   
    MsgBox "Done"
   
End Sub

Hi Herakles,

Thank you for helping with this. I copied the code and after I changed the "Destination" name to the active sheet "540006 Bernardo", it is telling me "Runtime error 9", "subscript out of range". I've attached a screen cap of the module where it fails.

Line failure: WbActive.Sheets(Split(WsActive.Range("AA1"), ",")).Copy

I have changed how the sheets were named in cell "AA1" (none of these changes worked for me):

Original: "540006 Bernardo", "540008 Foremost", "540263 Three Gov" - (Original had quotation marks and names were separated by commas)
1st revision: 540006 Bernardo, 540008 Foremost, 540263 Three Gov - (I removed the quotations)
2nd Revision: 540006 Bernardo 540008 Foremost 540263 Three Gov -(I removed the quotations & commas)
3rd Revision: "540006 Bernardo" "540008 Foremost" "540263 Three Gov" -(I removed just the commas)

I could only get past that part of the code by changing the named sheets in cell AA1 to just one name. Is there a special way of listing the names in the cell that I should be doing?

After getting this far, it created the new workbook (only 1 page of it because I changed the named sheets in cell "AA1" to just the first one), but then gives me a "Run-time error 1004:" "Method 'SaveAs' of object '_Workbook' failed" (I attached a screen cap of this). I also attached a screen cap of where the debugger failed in the module. Sorry for the censored spot, but it lists my full name and company. I wasn't able to figure out what the issue is on this spot. I did triple check that my file path is written correctly. Please let me know if you have any ideas that I can try to get it working.