Saveas, Save each worksheet as a separate workbook

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
      Workbooks.Add
      ActiveWorkbook.SaveAs _
         filename:=xpathname & wkSheetName & ".xls", _
         FileFormat:=xlNormal, Password:="", _
         WriteResPassword:="", CreateBackup:=False, _
         ReadOnlyRecommended:=False
      Set newWkbook = ActiveWorkbook
      
      Application.DisplayAlerts = False
      newWkbook.Worksheets("sheet1").Delete
      On Error Resume Next
      newWkbook.Worksheets(wkSheet.Name).Delete
      On Error GoTo 0
      Application.DisplayAlerts = True
 
      CurWkbook.Worksheets(wkSheet.Name).Copy Before:=newWkbook.Sheets(1)
      'no duplicate sheet1 because they begin with "a"
      ActiveWorkbook.Save
      ActiveWorkbook.Close
    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).

Related   (#related)

• Build Table of Contents, similar listings, working with Hyperlinks (buildtoc.htm)
• Collections (collections.htm)
• Excel Explosion 3.0 (DataPig tutorial) see video introduction. (listed at top of that page).  Data Explosion is free software to split up (copy) a worksheet into several sheets based on a column(s).  The Excel tuturials on this page are terrific.
• Making the activecell the LastCell (lastcell.htm#MakeLastCell)
• Pathname in headings, footers, and cells (pathname.htm)
• Reset All Lastcells in the Active Workbook (lastcell.htm#resetall)
• Slow Response, Memory Problems, and Speeding up Excel (slowresp.htm)
• Status Bar (statusbar.htm)
• Worksheets in VBA Coding and in Worksheet Formulas (sheets.htm)

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

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