Excel

Save Specific Sheets to a new Workbook

Ease of Use

Intermediate

Version tested with

2000, 2002 

Submitted by:

Justinlabenne

Description:

Specify certain sheets within your workbook to be copied into a seperate workbook. 

Discussion:

At work, monthly data is tracked, calculated, and then the results sheets need to be stored somewhere else so the data is not overwritten. Instead of saving the entire master workbook with all kinds of un-necessary extra sheets, and calculations that could still update, this code will copy the sheets you specify into a new workbook, with a title of your choosing, removing external links, Hyperlinks, and pasting formulas as values. E-mail routines could be added also, to send the new workbook as well as leave the copy. 

Code:

instructions for use

			

Option Explicit Sub TwoSheetsAndYourOut() Dim NewName As String Dim nm As Name Dim ws As Worksheet If MsgBox("Copy specific sheets to a new workbook" & vbCr & _ "New sheets will be pasted as values, named ranges removed" _ , vbYesNo, "NewCopy") = vbNo Then Exit Sub With Application .ScreenUpdating = False ' Copy specific sheets ' *SET THE SHEET NAMES TO COPY BELOW* ' Array("Sheet Name", "Another sheet name", "And Another")) ' Sheet names go inside quotes, seperated by commas On Error GoTo ErrCatcher Sheets(Array("Copy Me", "Copy Me2")).Copy On Error GoTo 0 ' Paste sheets as values ' Remove External Links, Hperlinks and hard-code formulas ' Make sure A1 is selected on all sheets For Each ws In ActiveWorkbook.Worksheets ws.Cells.Copy ws.[A1].PasteSpecial Paste:=xlValues ws.Cells.Hyperlinks.Delete Application.CutCopyMode = False Cells(1, 1).Select ws.Activate Next ws Cells(1, 1).Select ' Remove named ranges For Each nm In ActiveWorkbook.Names nm.Delete Next nm ' Input box to name new file NewName = InputBox("Please Specify the name of your new workbook", "New Copy") ' Save it with the NewName and in the same directory as original ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xls" ActiveWorkbook.Close SaveChanges:=False .ScreenUpdating = True End With Exit Sub ErrCatcher: MsgBox "Specified sheets do not exist within this workbook" End Sub

How to use:

  1. Copy the above code.
  2. Open any workbook.
  3. Press Alt + F11 to open the Visual Basic Editor (VBE).
  4. From the Menu, choose Insert-Module.
  5. Paste the code into the right-hand code window.
  6. Close the VBE (Alt + Q)
 

Test the code:

  1. Within the code , you will need to specify the sheets to copy
  2. When sheets are set, close the vbe (Alt + Q)
  3. Go to Tools > Macro > Macros
  4. When the dialog box appears:
  5. Double click on: TwoSheetsAndYourOut
 

Sample File:

SaveSomeSheets.zip 12.34KB 

Approved by mdmackillop


This entry has been viewed 630 times.

Please read our Legal Information and Privacy Policy
Copyright @2004 - 2020 VBA Express