VBA to Copy Multiple sheets to new workbook & save as .xlsb or .xlsx

rahildhody

Board Regular
Joined
Aug 4, 2016
Messages
55
Office Version
  1. 365
Platform
  1. Windows
Hi,

I have a vba code that needs to copy an array of sheets from one workbook & paste as values to another workbook & save the destination workbook as either xlsx or xlsx.

Below is the code:

VBA Code:
Sub SaveSheetsAsCSV()

    Dim ws As Worksheet, ws1 As Worksheet
    Dim newWorkbook As Workbook, wbSource As Workbook, wbDestination As Workbook
    Dim sheetNames As Variant
    Dim rngFilePath As Range, rngScenario As Range, rngVersion As Range
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ' Set the scenario, version & file path to save the new files
    Set rngFilePath = ThisWorkbook.Names("filepath").RefersToRange
    Set rngScenario = ThisWorkbook.Names("scenario").RefersToRange
    Set rngVersion = ThisWorkbook.Names("version").RefersToRange
    
    If Right(rngFilePath, 1) <> "\" Then
        rngFilePath = rngFilePath & "\"
    End If
        

'------------------------Create new workbook for budget assumptions template------------------------

    ' Set the source workbook
    Set wbSource = ThisWorkbook ' Change to the source workbook
    
    ' Set the destination workbook
    Set wbDestination = Workbooks.Add ' Change to the destination workbook
    
    ' Array of sheet names to be copied
    sheetNames = Array("Budget Inputs>>>", "Originations & Rates_budget", "Uniform Rolling Inputs", "Collective Provisions", "AUM_Collective Prov_budget", "CoF_budget") ' Add the names of the sheets you want to copy
    
    'copy array of sheets to the new workbook
    wbSource.Sheets(sheetNames).Copy Before:=wbDestination.Sheets(1)
    
    ' Paste as values and formatting
    For Each ws1 In wbDestination.Worksheets
    
            On Error Resume Next
                ws1.ShowAllData
            On Error GoTo 0
        
            ws1.Cells.Copy
            ws1.Range("A1").PasteSpecial Paste:=xlValues
        
    Next ws1

    ' Save the new workbook as xlsx with the worksheet name
    wbDestination.SaveAs rngFilePath & "Budget Assumptions Template_" & rngScenario & "_" & rngVersion & ".xlsb", FileFormat:=50

'wbDestination.SaveAs rngFilePath & "Budget Assumptions Template_" & rngScenario & "_" & rngVersion & ".xlsx", FileFormat:=51
    
    ' Close the new workbook without saving changes to it
    wbDestination.Close SaveChanges:=False



'------------------------Create new workbooks for ANAPLAN Upload files------------------------

    For Each ws In ThisWorkbook.Sheets(Array("MORT MET01 Upload", "MORT MET05 Upload", "MORT MET11 Upload", "MORT INP01 Upload", "MORT MET17 Upload", "DATAHUB LOA06"))
            
            On Error Resume Next
                ws.ShowAllData
            On Error GoTo 0
            
            Set newWorkbook = Workbooks.Add
            
            ' Rename the default sheet to the current worksheet name
            newWorkbook.Sheets(1).Name = ws.Name
            
            ' Copy the data from the original sheet to the new sheet
            ws.Cells.Copy newWorkbook.Sheets(1).Range("A1")
            
            ' Save the new workbook as CSV with the worksheet name
            newWorkbook.SaveAs rngFilePath & ws.Name & "_" & rngScenario & "_" & rngVersion & ".csv", xlCSV
            
            ' Close the new workbook without saving changes to it
            newWorkbook.Close SaveChanges:=False

    Next ws
    
    
  
    ' Release objects from memory
    Set wbSource = Nothing
    Set wbDestination = Nothing
    Set newWorkbook = Nothing
    Set ws = Nothing
    Set ws1 = Nothing
    
    
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    MsgBox "CSV files have been created and saved for specific worksheets.", vbInformation
End Sub


If i try using the commented code to saveas .xlsx, then the code skips the saving & jumps straight to the 2nd half of the code (which works perfectly) & if i use saveas .xlsb, then it gives me an error & asks me to debug or end the code & doesnt perform the function at all.

Not sure what I'm doing wrong. Could someone please assist with this?

Thanks in advance.
 
What if you tied building your file
this is not showing up when i run the code. is there a way to ensure that this dialogue box comes up everytime the file gets to the saveas stage?
Remove your Application.DisplayAlerts = False statement and see what happens.
 
Upvote 0

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
this worked & it shows the sensitivity dialogue box. but reason why i had display alerts=false is because sometimes users want to save over the file without getting prompted by excel if they'd like to replace the file. That dialogue box is now popping up as well.

Not the end of the world, but any chance to bypass that another way?

VBA Code:
Application.EnableEvents = True
    Application.DisplayAlerts = True
    
    ' Save the new workbook as xlsx with the worksheet name
    wbDestination.SaveAs rngFilePath & "Budget Assumptions Template_" & rngScenario & "_" & rngVersion & ".xlsx", FileFormat:=51
    
    Application.DisplayAlerts = False
    Application.EnableEvents = False
 
Upvote 0
sorry, i take that back. it worked when i ran it once. but when i run it again, it again skips it & goes to the 2nd half of the code!!!! ugggh!!
this worked & it shows the sensitivity dialogue box. but reason why i had display alerts=false is because sometimes users want to save over the file without getting prompted by excel if they'd like to replace the file. That dialogue box is now popping up as well.

Not the end of the world, but any chance to bypass that another way?

VBA Code:
Application.EnableEvents = True
    Application.DisplayAlerts = True
   
    ' Save the new workbook as xlsx with the worksheet name
    wbDestination.SaveAs rngFilePath & "Budget Assumptions Template_" & rngScenario & "_" & rngVersion & ".xlsx", FileFormat:=51
   
    Application.DisplayAlerts = False
    Application.EnableEvents = False
 
Upvote 0
You might also try building your file path in advance before calling the .SaveAs statement and then use DoEvents after to give the OS time to catch up.

VBA Code:
    ' Save the new workbook as xlsx with the worksheet name
    Dim FullPathName As String
    FullPathName = rngFilePath.Value & "Budget Assumptions Template_" & rngScenario.Value & "_" & rngVersion.Value & ".xlsx"
    wbDestination.SaveAs Filename:=FullPathName, FileFormat:=51
    DoEvents
   
    ' Close the new workbook without saving changes to it
    wbDestination.Close SaveChanges:=False

You could also check after the save to see if the new file has been created.
VBA Code:
    ' Save the new workbook as xlsx with the worksheet name
    Dim FullPathName As String
    FullPathName = rngFilePath.Value & "Budget Assumptions Template_" & rngScenario.Value & "_" & rngVersion.Value & ".xlsx"
    
    'Optionally delete any file with same name
    On Error Resume Next
    Kill FullPathName
    On Error GoTo 0
    
    wbDestination.SaveAs Filename:=FullPathName, FileFormat:=51
    DoEvents
    
    ' Close the new workbook without saving changes to it
    wbDestination.Close SaveChanges:=False
    DoEvents
    
    'Check to see if file was created
    With CreateObject("Scripting.FileSystemObject")
        If .FileExists(FullPathName) Then
            MsgBox "File:" & vbCr & vbCr & FullPathName & vbCr & vbCr & "was created", , "Success!"
        Else
            MsgBox "File:" & vbCr & vbCr & FullPathName & vbCr & vbCr & "was NOT created", , "Failure"
        End If
    End With
 
Upvote 0
Thank you for putting this together. Really appreciate it! I ran the code & it worked the 1st instance, created the file, brought up that sensitivity dialog box & message box for "File's been created" popped up. But when I ran it again, it didnt work & the message box for "NOT created" popped up. it did however kill the previously created file though.

I'm really unsure as to what's going on. is it the sensitivity thing that the company's put on thats causing the issue, or anything else. Im unable to pinpoint!
You might also try building your file path in advance before calling the .SaveAs statement and then use DoEvents after to give the OS time to catch up.

VBA Code:
    ' Save the new workbook as xlsx with the worksheet name
    Dim FullPathName As String
    FullPathName = rngFilePath.Value & "Budget Assumptions Template_" & rngScenario.Value & "_" & rngVersion.Value & ".xlsx"
    wbDestination.SaveAs Filename:=FullPathName, FileFormat:=51
    DoEvents
  
    ' Close the new workbook without saving changes to it
    wbDestination.Close SaveChanges:=False

You could also check after the save to see if the new file has been created.
VBA Code:
    ' Save the new workbook as xlsx with the worksheet name
    Dim FullPathName As String
    FullPathName = rngFilePath.Value & "Budget Assumptions Template_" & rngScenario.Value & "_" & rngVersion.Value & ".xlsx"
   
    'Optionally delete any file with same name
    On Error Resume Next
    Kill FullPathName
    On Error GoTo 0
   
    wbDestination.SaveAs Filename:=FullPathName, FileFormat:=51
    DoEvents
   
    ' Close the new workbook without saving changes to it
    wbDestination.Close SaveChanges:=False
    DoEvents
   
    'Check to see if file was created
    With CreateObject("Scripting.FileSystemObject")
        If .FileExists(FullPathName) Then
            MsgBox "File:" & vbCr & vbCr & FullPathName & vbCr & vbCr & "was created", , "Success!"
        Else
            MsgBox "File:" & vbCr & vbCr & FullPathName & vbCr & vbCr & "was NOT created", , "Failure"
        End If
    End With
 
Upvote 0
I'm not able to evaluate how or if your company's imposed sensitivity dialog is mucking things up, but it seems reasonable. There is a document sensitivity feature that's available by subscription for certain Office versions, such as the Enterprise version, but I've never had to deal with it myself. If it is a part of office then maybe there is a an API or object model for it that would somehow allow you to set the sensitivity label in code and remove the need for any pop-up form. I found this post that seems to suggest that there is.

Add sensitivity label.

That would be the best solution, but you might to have a talk with your corporate IT admin about that.
 
Upvote 0
I'm not able to evaluate how or if your company's imposed sensitivity dialog is mucking things up, but it seems reasonable. There is a document sensitivity feature that's available by subscription for certain Office versions, such as the Enterprise version, but I've never had to deal with it myself. If it is a part of office then maybe there is a an API or object model for it that would somehow allow you to set the sensitivity label in code and remove the need for any pop-up form. I found this post that seems to suggest that there is.

Add sensitivity label.

That would be the best solution, but you might to have a talk with your corporate IT admin about that.
thank you so much for all your help! I'll try figure something out.

its also interesting that it only works with savings files with xlsx, xlsb, xlsx, xls..but not with csv. csv's are created normally without the need for any label!
 
Upvote 0

Forum statistics

Threads
1,224,879
Messages
6,181,531
Members
453,054
Latest member
ezzat

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