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

[berlinhammer]

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

 

[ZVI]

Hi Jon,

Hold Ctrl key, click on tabs of the sheets to be copied and try the code:

Sub CopySelShtsAsValues()
  
  Dim Sh As Worksheet
  
  On Error GoTo if_err
  
  ' Copy selected sheets into new workbook
  Windows(1).SelectedSheets.Copy
  
  ' Replace formulas by values
  For Each Sh In Worksheets
    With Sh.UsedRange
      .Copy
      .PasteSpecial xlPasteValues
    End With
  Next
  
  ' Disable copy mode
  Application.CutCopyMode = False

' trap error
if_err:
  If Err Then MsgBox Err.Description, vbCritical, "Error"
  
End Sub

Regards

 

[berlinhammer]

That looks like the kind of thing I had in mind!

Didn't know about Window.Selectedsheets thanks for the tip ZVI

 

[ZVI]

That looks like the kind of thing I had in mind!

Didn't know about Window.Selectedsheets thanks for the tip ZVI

Happy to help,
Cheers!

 

[Isabella]

Hi Vladimir, i have a similar situation where i have a workbook and everyday i copy Sheets "Rec", "Team Criteria","Rec Criteria" to a new worbook, but is there a way without holding the CTRL key and selecting sheets manually?

Hi Jon,

Hold Ctrl key, click on tabs of the sheets to be copied and try the code:

Sub CopySelShtsAsValues()
  
  Dim Sh As Worksheet
  
  On Error GoTo if_err
  
  ' Copy selected sheets into new workbook
  Windows(1).SelectedSheets.Copy
  
  ' Replace formulas by values
  For Each Sh In Worksheets
    With Sh.UsedRange
      .Copy
      .PasteSpecial xlPasteValues
    End With
  Next
  
  ' Disable copy mode
  Application.CutCopyMode = False

' trap error
if_err:
  If Err Then MsgBox Err.Description, vbCritical, "Error"
  
End Sub

Regards

 

[berlinhammer]

Hi Isabella,

I'm afraid I don't have time to cut out the unnecessary code in the example below but this macro references a range of sheet names in a list on a sheet called "Key" in my workbook. It loops through the list and creates a values-only copy of those listed to my desktop.
You can just replace that loop with hard code for the sheet names you always refer to and it should do the trick with a bit of modification.

Hope that's of some use

Jon

Private Sub cmdNorthAmer_Click()
Dim wbO As Workbook, wbN As Workbook
Dim wsO As Worksheet, wsN As Worksheet, wsK As Worksheet, sh As Worksheet
Dim rngD As Range, rngK As Range, rngF As Range
Dim strF As String, strWso As String, strWsn As String
Dim i As Integer, iSht As Integer

Set wbO = ThisWorkbook
Set wbN = Workbooks.Add
wbO.Activate
Set wsK = wbO.Sheets("Key")
Set rngK = wsK.Range("shts_northamer")
Set rngF = rngK.Offset(0, 1)
iSht = WorksheetFunction.CountA(rngK)

Application.ScreenUpdating = False

For i = 1 To iSht
    strWso = rngK.Cells(i)
    strF = rngF.Cells(i)
    Set wsO = wbO.Sheets(strWso)
    wsO.Copy Before:=wbO.Sheets(1)
    Set wsN = ActiveSheet
    Set rngD = wsN.UsedRange
    If strF = "Yes" Then
        rngD.Copy
        rngD.PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        wsN.Cells(1).Select
    ElseIf strF = "No" Then
    End If
    wbO.Activate
    wsN.Move Before:=wbN.Sheets("Sheet1")
    ActiveSheet.Name = strWso
    wbO.Activate
Next i

i = 0

For Each sh In wbN.Sheets
    If sh.OLEObjects.count > 0 Then
        sh.OLEObjects(1).Delete
    Else: End If
Next sh
Set sh = Nothing

Application.DisplayAlerts = False
wbN.Sheets("Sheet1").Delete
wbN.Sheets("Sheet2").Delete
wbN.Sheets("Sheet3").Delete
wbN.Sheets(1).Activate
wbN.SaveAs "C:\Documents and Settings\temp1\Desktop\NorthAmer.xls"
Application.DisplayAlerts = True
Application.ScreenUpdating = True

wsK.Range("I6") = "Exported " & Now() & " GMT"
MsgBox wbN.Name & " Saved to " & wbN.Path
wbN.Close

wbO.Activate
Set wbO = Nothing
Set wbN = Nothing
Set wsO = Nothing
Set wsN = Nothing
Set wsK = Nothing
Set rngD = Nothing
Set rngK = Nothing
Set rngF = Nothing
strF = ""
strWso = ""
strWsn = ""

 

[crook_101]

Hey Isabella,

Create a new workbook called eg "Distribution" and paste this code.

Sub Sheet_mover()
With Workbooks("[COLOR=red]Insert your main sheet name here[/COLOR].xls")
        .Sheets(Array("Rec", "Team Criteria", "Rec Criteria")).Copy _
            Before:=Workbooks("Distribution.xls").Sheets(1)
 
 
End With
End Sub

Insert the name of your workbook where you want to copy the data from into the red font.

Ensure both workbooks are open and run the code

This will place the 3 sheets that you want into the "Distribution" workbook. Please test on a COPY of your original data.

HTH
Ian.

 

[ZVI]

Hi Isabella,

Too late (it's already answered), but anyway:
In the code of post #2 replace this line: Windows(1).SelectedSheets.Copy
By that one: Sheets(Array("Rec", "Team Criteria", "Rec Criteria")).Copy

Regards

 

[Isabella]

Hi Vladimir,

I have been reviewing my task and thought it would be better to to hide the sheets that i do not want people to see rather than create a whole new workbook

So is it possible to do this.

1. Hide sheets VeryHidden "RawData", "FX"

2. Make all the sheets as Values

3. Use the Saveas Dialogue box to allow the user to save the file

Hi Jon,

Hold Ctrl key, click on tabs of the sheets to be copied and try the code:

Sub CopySelShtsAsValues()
  
  Dim Sh As Worksheet
  
  On Error GoTo if_err
  
  ' Copy selected sheets into new workbook
  Windows(1).SelectedSheets.Copy
  
  ' Replace formulas by values
  For Each Sh In Worksheets
    With Sh.UsedRange
      .Copy
      .PasteSpecial xlPasteValues
    End With
  Next
  
  ' Disable copy mode
  Application.CutCopyMode = False

' trap error
if_err:
  If Err Then MsgBox Err.Description, vbCritical, "Error"
  
End Sub

Regards

 

[ZVI]

1. Hide sheets VeryHidden "RawData", "FX"
2. Make all the sheets as Values
3. Use the Saveas Dialogue box to allow the user to save the file

Try this code:

Sub CopyShtsAsValues()
  
  Dim Sh As Worksheet
  
  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
    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