Export spreadsheets from a workbook with VBA

The following code helps you to automate the routine job for saving each spreadsheet within the opened workbook as separated workbooks. It exports the spreadsheets into a specific directory - it uses the current date to create a new folder and then saves the files into it.

Sub create_workbooks()
'
' create_workbooks Macro
' VBA created 05/06/2008 by Profinvent
'

Dim wk As Workbook
Dim ws As Worksheet
Dim strName As String
Dim wkName As String

Application.ScreenUpdating = False
'On Error GoTo ErrHandler:

wkName = (Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4))

default_path = Format(Date, "yyyymmdd")
strName = InputBox(Prompt:="Save to:", Title:="Save file to:", _
'Path where the created files are going to be stored
Default:="C:\" & default_path & "_Exports\Reports\")

If strName = vbNullString Then GoTo ErrHandler:

For Each ws In Sheets
current_sheet = ws.Name
MsgBox (ws.Name & " has been created.")

ws.Copy
    ActiveWorkbook.SaveAs Filename:= _
        strName & wkName & "_" & current_sheet & ".xls" _
        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False

ActiveWorkbook.Close
Next ws
Application.ScreenUpdating = True
Exit Sub

ErrHandler:
Application.ScreenUpdating = True
MsgBox ("Error occured!")
End Sub

Partners Login

Sub Menu

Export spreadsheets from a workbook with VBA