Written by Allen Wyatt (last updated December 10, 2022)
This tip applies to Excel 2007, 2010, 2013, 2016, 2019, Excel in Microsoft 365, and 2021
Damodar has a workbook that contains a large number of worksheets. He would like to create individual workbooks for each worksheet, but have the name of the workbook be based on a cell (A7) in the worksheet being saved in the new workbook. Damodar knows he can do a "move or copy" of the individual worksheets to get them into new workbooks, but he's looking for something a bit more robust because of the large number of worksheets he's dealing with.
Peeling off worksheets into individual workbooks is relatively easy to do using macro. The following is just one possible macro; it steps through each worksheet and creates a brand-new workbook for each of those worksheets.
Sub SaveEachWks1() Dim wkb As Workbook Dim wSource As Workbook Dim wks As Worksheet Dim sPath As String Dim sFilename As String 'Location to store the files. Adjust as needed. sPath = "C:\MyPath\" ' Make sure process isn't disturbed Application.ScreenUpdating = False Application.EnableEvents = False Set wSource = ActiveWorkbook For Each wks In wSource.Worksheets ' Get the filename sFilename = wks.Range("A7").Text ' Comment out the following if A7 contains a filename extention sFilename = sFilename & ".xlsx" 'Copy the worksheet to a new workbook wks.Copy 'Define that workbook Set wkb = ActiveWorkbook ' Save the workbook with path and name, then close wkb.SaveAs Filename:=sPath & sFilename wkb.Close Next wks ' Again allow disturbances Application.EnableEvents = True Application.ScreenUpdating = True End Sub
Note that the macro sets the sFilename variable equal to the Text property for cell A7. This is done just in case the cell contains a formula that generates the filename. You should also make sure to comment out the line that adds a filename extension to sFilename if the name in cell A7 already contains a filename extension.
When you run the macro, one workbook is created for each worksheet in your selected workbook. Nothing in the original workbook is disturbed. Note, as well, that the macro takes quite a bit for granted. It doesn't, for instance, check to see if the filename in cell A7 is valid, nor does it check to see if a workbook with that filename already exists. Code to handle such situations could, however, be added to the macro. Here's an example of a more robust macro that does check for these possible problems:
Sub SaveEachWks2() Dim WB As Workbook Dim WS As Worksheet Dim w As Long Dim n As Integer Dim sPath As String Dim sExt As String Dim sName As String Dim sFile As String Const INVALID = "<>:""/\|?*" Const INSTEAD = "~" Const MAXLEN = 250 Set WB = ActiveWorkbook With Application 'save new workbooks in the active workbook's folder sPath = WB.Path & .PathSeparator sExt = IIf(.DefaultSaveFormat = xlWorkbookDefault, ".xlsx", ".xls") For Each WS In WB.Worksheets WS.Activate 'view each worksheet DoEvents .ScreenUpdating = False 'cell with new workbook's name With Range("A7") w = .Columns.ColumnWidth 'make it fit .Text .Columns.AutoFit sName = Trim(.Text) 'restore original width .Columns.ColumnWidth = w End With 'use worksheet's name if necessary If sName = "" Then sName = WS.Name 'ensure valid workbook name For n = 1 To Len(INVALID) sName = Replace(sName, Mid(INVALID, n, 1), INSTEAD, 1) Next n sFile = sPath & sName & sExt 'check length with margin for duplicate name n = Len(sFile) - MAXLEN If n > 0 Then sName = Left(sName, Len(sName) - n) sFile = sPath & sName & sExt End If n = 1 'check for file with same name Do Until Dir(sFile) = "" n = n + 1 sFile = sPath & sName & " (" & n & ")" & sExt Loop 'copy worksheet to new workbook, then save and close WS.Copy ActiveWorkbook.SaveAs Filename:=sFile ActiveWorkbook.Close .ScreenUpdating = True Next WS End With 'WB's last worksheet will remain active MsgBox WB.Worksheets.Count _ & " worksheets were copied as new workbooks in folder " _ & vbNewLine & sPath End Sub
This macro, if it finds an invalid character in the filename, replaces that character with a tilde (~) so there will be no error in saving the new workbook. It also saves the new workbooks in the same workbook in which the original workbook is saved.
Finally, you can always go the route of relying on an add-in to do the work for you. One add-in suggested by subscribers for Damodar's needs is ASAP Utilities, which you can find at this location:
https://www.asap-utilities.com
Note:
ExcelTips is your source for cost-effective Microsoft Excel training. This tip (5272) applies to Microsoft Excel 2007, 2010, 2013, 2016, 2019, Excel in Microsoft 365, and 2021.
Program Successfully in Excel! John Walkenbach's name is synonymous with excellence in deciphering complex technical topics. With this comprehensive guide, "Mr. Spreadsheet" shows how to maximize your Excel experience using professional spreadsheet application development tips from his own personal bookshelf. Check out Excel 2013 Power Programming with VBA today!
Tired of your workbooks being left open on the screen where they can be seen by anyone passing by? Here's a way to have ...
Discover MoreWorkbooks can get rather large rather quickly. If you think your workbook has gotten too big too fast, here are some ...
Discover MoreAs you work with a workbook over time, it is possible for the workbook to grow to a huge size. If you want to shrink the ...
Discover MoreFREE SERVICE: Get tips like this every week in ExcelTips, a free productivity newsletter. Enter your address and click "Subscribe."
There are currently no comments for this tip. (Be the first to leave your comment—just use the simple form above!)
Got a version of Excel that uses the ribbon interface (Excel 2007 or later)? This site is for you! If you use an earlier version of Excel, visit our ExcelTips site focusing on the menu interface.
FREE SERVICE: Get tips like this every week in ExcelTips, a free productivity newsletter. Enter your address and click "Subscribe."
Copyright © 2024 Sharon Parq Associates, Inc.
Comments