See it in Action!Watch this video to see this macro in action.
The CodeHere is the code for this macro. Make sure the following References are setup before running it: Visual Basic For Applications, Microsoft Excel 16.0 Object Library
'Leverage & Lean "Less Clicks, More Results" Sub SaveWorksheetsasWorkbooks() ' Means variable is in use Dim FilePath As String ' Dim WS As Worksheet ' On Error GoTo LeverageLean 'Hide ScreenUpdating and Display Alerts Application.ScreenUpdating = False Application.DisplayAlerts = False FilePath = Left(ActiveWorkbook.FullName, Len(ActiveWorkbook.FullName) - Len(ActiveWorkbook.Name)) 'Active Workbook File Path For Each WS In ActiveWorkbook.Sheets WS.Copy 'Copy Worksheet Application.ActiveWorkbook.SaveAs Filename:=FilePath & WS.Name & ".xlsx" 'Save new Workbooks to Active Workbook File Path Application.ActiveWorkbook.Close 'Remove if you want the New Workbooks to remain open Next MsgBox ("The Worksheets have been saved as Workbooks!") 'If not check your FilePath Exit Sub LeverageLean: MsgBox (Err.Number & " - " & Err.Description & vbNewLine & vbNewLine & "Don't hesitate to email me: email@example.com") End Sub 'Stay Awesome
Macro MondayHere is the Macro Monday video this macro was featured in. Watch this video to learn how to get the most out of this macro and start using it today!
CustomizationThese lines of code can be customized to personalize this macro.
13. FilePath = Left(ActiveWorkbook.FullName, Len(ActiveWorkbook.FullName) – Len(ActiveWorkbook.Name)) ‘Active Workbook File Path Change the FilePath so the new workbooks save somewhere else
21. MsgBox (“The Worksheets have been created into Workbooks!”) ‘If not check your FilePath Remove the MsgBox or make it comment to not see it once the macro finishes