Warning

 

Close

Confirm Action

Are you sure you wish to do this?

Confirm Cancel
BCM
User Panel

Posted: 10/21/2016 5:46:16 AM EDT
I have a couple of excel files that have multiple tabs in it.  I am talking like 30-40 tabs...

Is there away to easily (as in a one shot deal), break this file up so that each tab becomes a separate file ?

I know about right clicking and copying to a new file, but I don't want to do that 30-40 times.
Link Posted: 10/21/2016 6:32:38 AM EDT
[#1]
Take a look at option 2 on this site: https://www.extendoffice.com/documents/excel/628-excel-split-workbook.html.

I've never used it personally. Hope it works!
Link Posted: 10/21/2016 8:24:32 AM EDT
[#2]
Download ASAP Utilities.

Link Posted: 10/21/2016 8:29:58 AM EDT
[#3]
Yes. VBA.

Pseudocode:

Sub make_workbooks()

Dim ws as Worksheet
Dim newwb as Workbook


For each ws in thisworkbook.sheets
   Ws.copy
   Set newwb = activeworkbook
   newwb.saveas (save info here, I forget exactly what it is)
   Set newwb = nothing
Next ws

End sub


This is off the cuff. I don't have excel in front of me to build it out.
Link Posted: 10/21/2016 9:02:14 AM EDT
[#4]
Tag for some vba when I get to the office.
Link Posted: 10/21/2016 11:07:22 AM EDT
[#5]
Another "brute force" method:

save it, delete all but desired sheet, save as, repeat.
Link Posted: 10/21/2016 11:15:22 AM EDT
[#6]
Discussion ForumsJump to Quoted PostQuote History
Quoted:
Tag for some vba when I get to the office.
View Quote

Here's some VBA code to do that for you.  You'll need to use it in each workbook.  Run the 'SplitWorkbookSheets' sub.
@OP, you know how to use Excel's built in VBA?


' Set variables
Public ThisBook, ThatBook, SavePath, SaveName, sLoop, SwapChar
Sub SplitWorkbookSheets()
' for the workbook this module is located, cycle through each tab (sheet), copy to a new file and save each new file with the tab name
' new files will save in the same directory as the source file.
' make sure none of the tabs has the same name as the source file
   
' set the source workbook name and path, activate the source book, if it's not already active
   ThisBook = ThisWorkbook.Name
   SavePath = ThisWorkbook.Path & "\"
   ChDir SavePath
   Windows(ThisBook).Activate
   
   Application.ScreenUpdating = False ' turn off screen updating for speed
' loop through the sheets in the source book
   For sLoop = 1 To Sheets.Count
       Windows(ThisBook).Activate ' ensure the source book is active
       Sheets(sLoop).Select ' select each sheet in order
       SaveName = Sheets(sLoop).Name ' grab the sheet name
       CleanTabName ' call sub to clean filename up
       Sheets(sLoop).Copy ' copy the sheet to a fresh workbook.  to delete the sheet from the source book, change .Copy to .Move
       ' This section saves the workbook in the same directory as the source file.  The alerts are turned off so it won't error out if you try to overwrite an existing workbook
       Application.DisplayAlerts = False
           ActiveWorkbook.SaveAs Filename:=SavePath & SaveName & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
           ThatBook = ActiveWorkbook.Name
           Windows(ThatBook).Activate
           ActiveWorkbook.Close
       Application.DisplayAlerts = True
   Next sLoop
   Application.ScreenUpdating = True ' turn the screen updating back on
End Sub

Sub CleanTabName()
' clean out characters that might choke windows filenaming conventions
   SwapChar = "<"
   SaveName = Replace(SaveName, SwapChar, "_")
   SwapChar = ">"
   SaveName = Replace(SaveName, SwapChar, "_")
   SwapChar = ":"
   SaveName = Replace(SaveName, SwapChar, "_")
   SwapChar = "'"
   SaveName = Replace(SaveName, SwapChar, "_")
   SwapChar = "/"
   SaveName = Replace(SaveName, SwapChar, "_")
   SwapChar = "\"
   SaveName = Replace(SaveName, SwapChar, "_")
   SwapChar = "|"
   SaveName = Replace(SaveName, SwapChar, "_")
   SwapChar = "?"
   SaveName = Replace(SaveName, SwapChar, "_")
   SwapChar = "*"
   SaveName = Replace(SaveName, SwapChar, "_")
   SwapChar = "#"
   SaveName = Replace(SaveName, SwapChar, "_")
   SwapChar = "$"
   SaveName = Replace(SaveName, SwapChar, "_")
   SwapChar = "+"
   SaveName = Replace(SaveName, SwapChar, "_")
   SwapChar = "%"
   SaveName = Replace(SaveName, SwapChar, "_")
   SwapChar = "!"
   SaveName = Replace(SaveName, SwapChar, "_")
   SwapChar = "`"
   SaveName = Replace(SaveName, SwapChar, "_")
   SwapChar = "&"
   SaveName = Replace(SaveName, SwapChar, "_")
   SwapChar = "{"
   SaveName = Replace(SaveName, SwapChar, "_")
   SwapChar = "="
   SaveName = Replace(SaveName, SwapChar, "_")
   SwapChar = "}"
   SaveName = Replace(SaveName, SwapChar, "_")
   SwapChar = "@"
   SaveName = Replace(SaveName, SwapChar, "_")
   SwapChar = """"
   SaveName = Replace(SaveName, SwapChar, "_")
End Sub
Close Join Our Mail List to Stay Up To Date! Win a FREE Membership!

Sign up for the ARFCOM weekly newsletter and be entered to win a free ARFCOM membership. One new winner* is announced every week!

You will receive an email every Friday morning featuring the latest chatter from the hottest topics, breaking news surrounding legislation, as well as exclusive deals only available to ARFCOM email subscribers.


By signing up you agree to our User Agreement. *Must have a registered ARFCOM account to win.
Top Top