Excel

Save All Worksheets As Individual Workbooks In a Special Folder

Ease of Use

Easy

Version tested with

2000, 2003 

Submitted by:

johnske

Description:

A new folder with the active workbook's name will be created. Inside this folder there will be a number of single-sheet workbooks, each one of these will contain the contents of one of the sheets in the active workbook. (To assist the user, the name of each workbook will also be the sheet's name). 

Discussion:

You may have a workbook with (say) a student's/employee's details on each worksheet. Over time, this may become too large or unwieldy to use, and you may want to convert each one to a separate workbook for further expansion.... Alternatively, you may wish to make the contents of each student/employee available to that person (perhaps by emailing it as an attachment) without any risk of breaching confidentiality. This can be done by converting each of the worksheets to a workbook, and only making this 'personal workbook' available to the respective person. 

Code:

instructions for use

			

Option Explicit Sub SaveShtsAsBook() Dim Sheet As Worksheet, SheetName$, MyFilePath$, N& MyFilePath$ = ActiveWorkbook.Path & "\" & _ Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) With Application .ScreenUpdating = False .DisplayAlerts = False ' End With On Error Resume Next '<< a folder exists MkDir MyFilePath '<< create a folder For N = 1 To Sheets.Count Sheets(N).Activate SheetName = ActiveSheet.Name Cells.Copy Workbooks.Add (xlWBATWorksheet) With ActiveWorkbook With .ActiveSheet .Paste .Name = SheetName [A1].Select End With 'save book in this folder .SaveAs Filename:=MyFilePath _ & "\" & SheetName & ".xls" .Close SaveChanges:=True End With .CutCopyMode = False Next End With Sheet1.Activate End Sub

How to use:

  1. Open an Excel workbook
  2. Select Tools/Macro/Visual Basic Editor
  3. In the VBE window, select Insert/Module
  4. Copy and paste the code into the Module
  5. Now select File/Close and Return To Microsoft Excel
  6. Save your work.
 

Test the code:

  1. Place your workbook on the desktop to test this (n.b. it can be run from any folder)
  2. Select Tools/Macro/Macros.../SaveShtsAsBook/Run
  3. After running, you will see a new folder on the desktop with the same name as your workbook
  4. Open this folder and check that it contains a number of workbooks named after the sheets in the original workbook.
  5. Open each workbook to check that it only contains the contents of the same sheet in the original workbook.
  6. (Alternatively, download the attachment and use the workbook in the folder)
 

Sample File:

Save Sheets As Books.zip 13.72KB 

Approved by mdmackillop


This entry has been viewed 428 times.

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