Saveas, Save each worksheet as a separate workbook

Home page:
[View without Frames]

Save each worksheet separately to multiple workbooks (#MakeMultipleXLSfromWB)

This subroutine is going to take awhile to run so would suggest that you exit out of each module in the VBE and then exit out of the VBE itself; otherwise, even though screen updating is turned off you will be bouncing around in the VBE constantly changing views.  To help keep you informed the status bar will tell you how far you have progressed.  The files will be created in a datestamped directory in your temporary file -- i.e. c:\temp\Dyyyymmdd_hhmmss

As a further aid Sheet1 will be deleted from the new workbook and if an existing sheet {sheet1, sheet2, sheet3} that remains is named the same as the worksheet name then it also will be deleted before copying in the original sheet to the beginning of the tab names.

Option Explicit

Sub MakeMultipleXLSfromWB()
  'Split worksheets in current workbook into
  ' many separate workbooks  D.McRitchie, 2004-06-12
  'Close each module  AND the VBE before running to save time
  ' provides a means of seeing how big sheets really are
  'Hyperlinks and formulas pointing to other worksheets within
  ' the original workbook will usually be unuseable in the new workbooks.
    Dim CurWkbook As Workbook
    Dim wkSheet As Worksheet
    Dim newWkbook As Workbook
    Dim wkSheetName As String
    Dim shtcnt(3) As Long
    Dim xpathname As String, dtimestamp As String
    dtimestamp = Format(Now, "yyyymmdd_hhmmss")
    xpathname = "c:\temp\D" & dtimestamp & "\"
    MkDir xpathname
    Set CurWkbook = Application.ActiveWorkbook

    shtcnt(2) = ActiveWorkbook.Sheets.Count
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    For Each wkSheet In CurWkbook.Worksheets
      shtcnt(1) = shtcnt(1) + 1
      Application.StatusBar = shtcnt(1) & "/" & shtcnt(2) & _
          "  " & wkSheet.Name
      wkSheetName = Trim(wkSheet.Name)
      If wkSheetName = Left(Application.ActiveWorkbook.Name, _
         Len(Application.ActiveWorkbook.Name) - 4) Then _
         wkSheetName = wkSheetName & "_D" & dtimestamp
      ActiveWorkbook.SaveAs _
         filename:=xpathname & wkSheetName & ".xls", _
         FileFormat:=xlNormal, Password:="", _
         WriteResPassword:="", CreateBackup:=False, _
      Set newWkbook = ActiveWorkbook
      Application.DisplayAlerts = False
      On Error Resume Next
      On Error GoTo 0
      Application.DisplayAlerts = True
      CurWkbook.Worksheets(wkSheet.Name).Copy Before:=newWkbook.Sheets(1)
      'no duplicate sheet1 because they begin with "a"
    Next wkSheet
    Application.StatusBar = False      'return control to Excel
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Testing indicated that you want to include the file extension when saving; otherwise, worksheets with a period in their name will be saved incorrectly. 

Also tested worksheet with same name as workbook (except for the .xls extension) and have resolved conflict by adding the datetimestamp to the newworkbook name because you can't have two workbooks with the same name open at the same time.  From a workbook named xenu.xls the following workbooks were generated:  xenu.xls.xls from worksheet named xenu.xls, xenu xls.xls from worksheet named xenu xls, and xenu_D20040612_154559.xls from worksheet named xenu

Additional problems:  By splitting the workbook up you will destroy internal references for both hyperlinks and for formulas referencing non existent sheets in the new workbooks.

Added benefit:  You can use this subroutine to spot worksheets that are excessive in size.  The table from Build Table of Contents would help you spot such sheets but this will really tell you how big the sheet actually is.

File, Save As (#saveas)

It appears that File, Save As, in itself fixes lastcell problems in a workbook at least in Excel 2002 & 2003.  (Patricia Shannon, 2006-02-15, newusers).
This page contains some VBA macros.  If you need assistance to install or to use a macro please refer to Getting Started with Macros.  For more depth see Install a Macro or User Defined Function  on my Formula page.

Speed and efficiency considerations can be seen in Proper, and other Text changes and in Slow Response.

Excel questions not directly concerning my web pages are best directed to newsgroups
such as news:// where Excel users all around the clock from at least 6 continents ask and answer Excel questions.  If you don't see something on my website, I probably don't know the answer either, so use the newsgroups.   Posting suggestions and netiquette.  More information on newsgroups and searching newsgroups.    Google Groups (Usenet) Advanced Search Excel newsgroups (or search any newsgroup).
This page was introduced on June 12, 2004. 
[My Excel Pages -- home]    [INDEX to my site and the off-site pages I reference] 
[Site Search -- Excel]     [Go Back]    [Return to TOP

Please send your comments concerning this web page to: David McRitchie send email comments

Copyright © 1997 - 2004,  F. David McRitchie,  All Rights Reserved