SOLVED

Excel VBA to put each sheet into an individual Excel file (split book)

%3CLINGO-SUB%20id%3D%22lingo-sub-3510794%22%20slang%3D%22en-US%22%3EExcel%20VBA%20to%20put%20each%20sheet%20into%20an%20individual%20Excel%20file%20(split%20book)%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-3510794%22%20slang%3D%22en-US%22%3E%3CP%3EHello-%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EI'm%20trying%20to%20save%20a%20new%20Excel%20file%20for%20each%20sheet%20in%20an%20Excel%20file.%26nbsp%3B%20I%20found%20this%20code%2C%20but%20it%20only%20works%20if%20the%20code%20is%20written%20into%20the%20VBA%20module%20of%20the%20Excel%20I%20wish%20to%20parse.%26nbsp%3B%20I%20want%20to%20save%20the%20code%20in%20a%20macro%20enabled%20Excel%20.xlsm%20so%20I%20can%20run%20it%20on%20an%20Excel.xslx%20file.%26nbsp%3B%20I%20think%20the%20problem%20has%20something%20to%20do%20with%20the%20%22ActiveWorkbook%22%20command...%26nbsp%3B%20Thanks%20for%20your%20help%20in%20advance!%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3ESub%20Splitbook()%3CBR%20%2F%3E%3CBR%20%2F%3E%3C%2FP%3E%3CP%3EDim%20xPath%20As%20String%3CBR%20%2F%3ExPath%20%3D%20Application.ActiveWorkbook.Path%3CBR%20%2F%3EApplication.ScreenUpdating%20%3D%20False%3CBR%20%2F%3EApplication.DisplayAlerts%20%3D%20False%3CBR%20%2F%3EFor%20Each%20xWs%20In%20ThisWorkbook.Sheets%3CBR%20%2F%3ExWs.Copy%3CBR%20%2F%3EApplication.ActiveWorkbook.SaveAs%20Filename%3A%3DxPath%20%26amp%3B%20%22%5C%22%20%26amp%3B%20xWs.Name%20%26amp%3B%20%22.xlsx%22%3CBR%20%2F%3EApplication.ActiveWorkbook.Close%20False%3CBR%20%2F%3ENext%3CBR%20%2F%3EApplication.DisplayAlerts%20%3D%20True%3CBR%20%2F%3EApplication.ScreenUpdating%20%3D%20True%3CBR%20%2F%3EEnd%20Sub%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-LABS%20id%3D%22lingo-labs-3510794%22%20slang%3D%22en-US%22%3E%3CLINGO-LABEL%3EExcel%3C%2FLINGO-LABEL%3E%3C%2FLINGO-LABS%3E%3CLINGO-SUB%20id%3D%22lingo-sub-3510975%22%20slang%3D%22en-US%22%3ERe%3A%20Excel%20VBA%20to%20put%20each%20sheet%20into%20an%20individual%20Excel%20file%20(split%20book)%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-3510975%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F1425262%22%20target%3D%22_blank%22%3E%40CreativeSteph%3C%2FA%3E%26nbsp%3B%20I%20haven't%20tested%20it%2C%20but%20assuming%20the%20code%20itself%20works%20it%20looks%20like%20you%20might%20only%20need%20to%20change%20the%20one%20part%20I%20highlighted%20in%20red%3A%3C%2FP%3E%3CP%3ESub%20Splitbook()%3CBR%20%2F%3E%3CBR%20%2F%3E%3C%2FP%3E%3CP%3EDim%20xPath%20As%20String%3CBR%20%2F%3ExPath%20%3D%20Application.ActiveWorkbook.Path%3CBR%20%2F%3EApplication.ScreenUpdating%20%3D%20False%3CBR%20%2F%3EApplication.DisplayAlerts%20%3D%20False%3CBR%20%2F%3EFor%20Each%20xWs%20In%20%3CFONT%20color%3D%22%23DF0000%22%3EActive%3C%2FFONT%3EWorkbook.Sheets%3CBR%20%2F%3ExWs.Copy%3CBR%20%2F%3EApplication.ActiveWorkbook.SaveAs%20Filename%3A%3DxPath%20%26amp%3B%20%22%5C%22%20%26amp%3B%20xWs.Name%20%26amp%3B%20%22.xlsx%22%3CBR%20%2F%3EApplication.ActiveWorkbook.Close%20False%3CBR%20%2F%3ENext%3CBR%20%2F%3EApplication.DisplayAlerts%20%3D%20True%3CBR%20%2F%3EApplication.ScreenUpdating%20%3D%20True%3CBR%20%2F%3EEnd%20Sub%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-3511121%22%20slang%3D%22en-US%22%3ERe%3A%20Excel%20VBA%20to%20put%20each%20sheet%20into%20an%20individual%20Excel%20file%20(split%20book)%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-3511121%22%20slang%3D%22en-US%22%3EThanks%20so%20much%20mtarler!%20It%20works!%20One%20little%20thing%20can%20throw%20off%20the%20whole%20project!%3C%2FLINGO-BODY%3E
New Contributor

Hello-

 

I'm trying to save a new Excel file for each sheet in an Excel file.  I found this code, but it only works if the code is written into the VBA module of the Excel I wish to parse.  I want to save the code in a macro enabled Excel .xlsm so I can run it on an Excel.xslx file.  I think the problem has something to do with the "ActiveWorkbook" command...  Thanks for your help in advance!

 

 

Sub Splitbook()

Dim xPath As String
xPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In ThisWorkbook.Sheets
xWs.Copy
Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

2 Replies
best response confirmed by CreativeSteph (New Contributor)
Solution

@CreativeSteph  I haven't tested it, but assuming the code itself works it looks like you might only need to change the one part I highlighted in red:

Sub Splitbook()

Dim xPath As String
xPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In ActiveWorkbook.Sheets
xWs.Copy
Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Thanks so much mtarler! It works! One little thing can throw off the whole project!