Create new workbook from selected worksheets of master file (values only)

berlinhammer

Board Regular
Joined
Jan 30, 2009
Messages
187
Hello,

I have a very large workbook containing a lot of worksheets with a lot of data, formulae, data connections and macros. I like having the master file as a central source but I need to send it to various Global locations for verification, and the size and complexity of the file is a problem.

On a high level I think what would really be beneficial would be a macro which exports a group of selected worksheets to a new workbook, as values only and with any links/formulae/macros broken.

My googling leads to believe that this is more compliacted to achieve than I would have liked. Is this fair to say? My VBA is decent though far from expert, and I have never written anything involving grouped sheets or file creation before.

Has anyone come across a similar macro to the purpose I am describing or have a suggestion as to a good place to start? Such as the syntax for copying and exporting a group of sheets.

Grateful for any help or advice anyone can offer,

Thank you

Jon
 
Sure, Isabella.

1. Saving: ThisWorkbook.Save

2. Closing: ThisWorkbook.Close
If there are not saved changes in closing workbook, then Excel prompts for saving changes.

Regards

Ok do i put this at the start of the code like this or at the end?



Code:
Sub CopyShtsAsValues()
  
  Dim Sh As Worksheet
  
  On Error GoTo exit_
  
  ' Screen off
  Application.ScreenUpdating = False
  
  ' Copy sheets into new workbook
  Sheets.Copy

  ThisWorkbook.Save

  ThisWorkbook.Close
  
  ' Replace formulas by values
  For Each Sh In Worksheets
    Sh.Visible = xlSheetVisible
    With Sh.UsedRange
      .Copy
      .PasteSpecial xlPasteValues
    End With
  Next
  
  ' Make some sheets very hidden
  Sheets("RawData").Visible = xlSheetVeryHidden
  Sheets("FX").Visible = xlSheetVeryHidden
  
  ' Disable copy mode, restore screen on
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
  
  ' Call SaveAs dialog
  ChDrive ThisWorkbook.Path
  ChDir ThisWorkbook.Path
  CommandBars.FindControl(, 748).Execute
  
exit_:
  
  ' Trap error
  If Err Then MsgBox Err.Description, vbCritical, "Error"
  
End Sub
</pre>
 
Upvote 0

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Isabella, it would be good at the end of the code, just before End Sub
 
Upvote 0
Isabella,

There is nothing in the code to select all sheets.
Copying of already selected sheets was used only in post #2 for Jon’s task.

If sheets been selected before running of code, then for deselecting it, add the following code below the line Sheets.Copy:
Sheets(1).Select

Regards

The sheet select thing did not work on the new wkbk, the master wkbk is fine

Sheets.Copy will make the sheets all selected
 
Upvote 0
Isabella,

You are talking about "all the worksheets are selected" but it seems you mean "cells in all worksheets are selected", which is different.

If so, then try:
Rich (BB code):

Sub CopyShtsAsValues1()
  
  Dim Sh As Worksheet, sel As Range
  
  On Error GoTo exit_
  
  ' Screen off
  Application.ScreenUpdating = False
  
  ' Copy sheets into new workbook
  Sheets.Copy
  
  ' Replace formulas by values
  For Each Sh In Worksheets
    Sh.Visible = xlSheetVisible
    Sh.Activate
    Set sel = Selection
    With Sh.UsedRange
      .Copy
      .PasteSpecial xlPasteValues
    End With
    sel.Select
  Next
  
  ' Make some sheets very hidden
  Sheets("RawData").Visible = xlSheetVeryHidden
  Sheets("FX").Visible = xlSheetVeryHidden
  
  ' Disable copy mode
  Application.CutCopyMode = False
  
  ' Call SaveSs method
  ChDrive ThisWorkbook.Path
  ChDir ThisWorkbook.Path
  CommandBars.FindControl(, 748).Execute
  
exit_:
  
  ' Restore screen on
  Application.ScreenUpdating = True
  
  ' Trap error
  If Err Then MsgBox Err.Description, vbCritical, "Error": Exit Sub
    
  ' Save & close master workbook
  ThisWorkbook.Save
  ThisWorkbook.Close
    
End Sub

Regards
 
Upvote 0
Thanks that worked.

With this piece of code is it possible for the the code to look at the named range file path, i have a file path that is called "rngPath"

Also if the user decided to cancel via the Saveas Dialogue box, then could the code close and not save the new wkbk and have msgbox saying "User Cancelled"



Code:
' Call SaveSs method
  ChDrive ThisWorkbook.Path
  ChDir ThisWorkbook.Path
  CommandBars.FindControl(, 748).Execute
</pre>



Isabella,

You are talking about "all the worksheets are selected" but it seems you mean "cells in all worksheets are selected", which is different.

If so, then try:
Rich (BB code):

Sub CopyShtsAsValues1()
  
  Dim Sh As Worksheet, sel As Range
  
  On Error GoTo exit_
  
  ' Screen off
  Application.ScreenUpdating = False
  
  ' Copy sheets into new workbook
  Sheets.Copy
  
  ' Replace formulas by values
  For Each Sh In Worksheets
    Sh.Visible = xlSheetVisible
    Sh.Activate
    Set sel = Selection
    With Sh.UsedRange
      .Copy
      .PasteSpecial xlPasteValues
    End With
    sel.Select
  Next
  
  ' Make some sheets very hidden
  Sheets("RawData").Visible = xlSheetVeryHidden
  Sheets("FX").Visible = xlSheetVeryHidden
  
  ' Disable copy mode
  Application.CutCopyMode = False
  
  ' Call SaveSs method
  ChDrive ThisWorkbook.Path
  ChDir ThisWorkbook.Path
  CommandBars.FindControl(, 748).Execute
  
exit_:
  
  ' Restore screen on
  Application.ScreenUpdating = True
  
  ' Trap error
  If Err Then MsgBox Err.Description, vbCritical, "Error": Exit Sub
    
  ' Save & close master workbook
  ThisWorkbook.Save
  ThisWorkbook.Close
    
End Sub
Regards
 
Upvote 0
Try:
Rich (BB code):

Sub CopyShtsAsValues2()
  
  Dim Sh As Worksheet, sel As Range
  
  On Error GoTo exit_
  
  ' Screen off
  Application.ScreenUpdating = False
  
  ' Copy sheets into new workbook
  Sheets.Copy
  
  ' Replace formulas by values
  For Each Sh In Worksheets
    Sh.Visible = xlSheetVisible
    Sh.Activate
    Set sel = Selection
    With Sh.UsedRange
      .Copy
      .PasteSpecial xlPasteValues
    End With
    sel.Select
  Next
  
  ' Make some sheets very hidden
  Sheets("RawData").Visible = xlSheetVeryHidden
  Sheets("FX").Visible = xlSheetVeryHidden
  
  ' Disable copy mode
  Application.CutCopyMode = False
  
  ' Call SaveSs method
  ChDrive ThisWorkbook.Range("rngPath") ' was: ThisWorkbook.Path
  ChDir ThisWorkbook.Range("rngPath")   ' was: ThisWorkbook.Path
  CommandBars.FindControl(, 748).Execute
  
exit_:
  
  ' Restore screen on
  Application.ScreenUpdating = True
  
  ' Trap error
  If Err Then MsgBox Err.Description, vbCritical, "Error": Exit Sub
    
  ' Save & close master workbook
  If ActiveWorkbook.Saved Then
    ThisWorkbook.Save
    ThisWorkbook.Close
  End If
    
End Sub
 
Last edited:
Upvote 0
The same , but with prompting:
Rich (BB code):

Sub CopyShtsAsValues3()
  
  Dim Sh As Worksheet, sel As Range
  
  On Error GoTo exit_
  
  ' Screen off
  Application.ScreenUpdating = False
  
  ' Copy sheets into new workbook
  Sheets.Copy
  
  ' Replace formulas by values
  For Each Sh In Worksheets
    Sh.Visible = xlSheetVisible
    Sh.Activate
    Set sel = Selection
    With Sh.UsedRange
      .Copy
      .PasteSpecial xlPasteValues
    End With
    sel.Select
  Next
  
  ' Make some sheets very hidden
  Sheets("RawData").Visible = xlSheetVeryHidden
  Sheets("FX").Visible = xlSheetVeryHidden
  
  ' Disable copy mode
  Application.CutCopyMode = False
  
  ' Call SaveAs dialog
  ChDrive ThisWorkbook.Range("rngPath") ' was: ThisWorkbook.Path
  ChDir ThisWorkbook.Range("rngPath")   ' was: ThisWorkbook.Path
  CommandBars.FindControl(, 748).Execute
  
exit_:
  
  ' Restore screen on
  Application.ScreenUpdating = True
  
  ' Trap error
  If Err Then MsgBox Err.Description, vbCritical, "Error": Exit Sub
    
  ' Save & close master workbook
  If ActiveWorkbook.Saved Then
    ThisWorkbook.Save
    ThisWorkbook.Close
  Else
    MsgBox "User Cancelled", vbExclamation, "Not saved"
  End If
    
End Sub
 
Last edited:
Upvote 0
i get a compile error on this code

"Method or data member not found"

ChDrive ThisWorkbook.Range("rngPath")


The same , but with prompting:
Rich (BB code):

Sub CopyShtsAsValues3()
  
  Dim Sh As Worksheet, sel As Range
  
  On Error GoTo exit_
  
  ' Screen off
  Application.ScreenUpdating = False
  
  ' Copy sheets into new workbook
  Sheets.Copy
  
  ' Replace formulas by values
  For Each Sh In Worksheets
    Sh.Visible = xlSheetVisible
    Sh.Activate
    Set sel = Selection
    With Sh.UsedRange
      .Copy
      .PasteSpecial xlPasteValues
    End With
    sel.Select
  Next
  
  ' Make some sheets very hidden
  Sheets("RawData").Visible = xlSheetVeryHidden
  Sheets("FX").Visible = xlSheetVeryHidden
  
  ' Disable copy mode
  Application.CutCopyMode = False
  
  ' Call SaveAs dialog
  ChDrive ThisWorkbook.Range("rngPath") ' was: ThisWorkbook.Path
  ChDir ThisWorkbook.Range("rngPath")   ' was: ThisWorkbook.Path
  CommandBars.FindControl(, 748).Execute
  
exit_:
  
  ' Restore screen on
  Application.ScreenUpdating = True
  
  ' Trap error
  If Err Then MsgBox Err.Description, vbCritical, "Error": Exit Sub
    
  ' Save & close master workbook
  If ActiveWorkbook.Saved Then
    ThisWorkbook.Save
    ThisWorkbook.Close
  Else
    MsgBox "User Cancelled", vbExclamation, "Not saved"
  End If
    
End Sub
 
Upvote 0
My bad, replace it by:
Rich (BB code):

  ChDrive [rngPath]
  ChDir [rngPath]
It is expected that value of rngPath named range is the path like C:\User\Isabella\Temp and this path is present
 
Upvote 0
My bad, replace it by:
Rich (BB code):

  ChDrive [rngPath]
  ChDir [rngPath]
It is expected that value of rngPath named range is the path like C:\User\Isabella\Temp and this path is present

Ok that works but when i run the code and get to the saveas dialogue box i press cancel the new wbk is still open, is it possible for the code to remove this workbook completely as the user had cancelled and only leave the master workbook open. If the user saves then its ok for the master workbook to save and close.
 
Upvote 0

Forum statistics

Threads
1,223,275
Messages
6,171,127
Members
452,381
Latest member
Nova88

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