Let's Talk Excel

Save Each Excel Sheet To A Separate File

This VBA code saves each Worksheet in the active Excel Workbook to a separate file and even lets you decide whether to keep the formulas on the sheets or change them to values. When you run the code, you will be asked for the folder location where the files should be created. Sheets will not be deleted from the old Workbook and it will not be effected in any way.

Sub SheetsSaveInSeparateFiles()
Dim objFolders As Object

Set WshShell = CreateObject("WScript.Shell")
FOL = WshShell.SpecialFolders("MyDocuments")

    If Sheets.Count > 0 Then
        fldr = GetFolder(FOL)
        If fldr <> "" Then
            yn = MsgBox("Preserve formulas?", vbYesNo)
            cnt = 0
            Application.ScreenUpdating = False
            Application.DisplayAlerts = False
            For Each sh In ActiveWorkbook.Sheets
                If yn = vbNo Then
                    With ActiveSheet.UsedRange
                        .Value = .Value
                    End With
                End If
                On Error Resume Next
                Application.ActiveWorkbook.SaveAs Filename:=fldr & "\" & sh.Name & ".xlsx"
                er = Err.Number
                dsc = Err.Description
                On Error GoTo 0
                If er <> 0 Then
                    MsgBox "Had trouble saving " & fldr & "\" & sh.Name & ".xlsx"
                    MsgBox dsc
                    cnt = cnt + 1
                End If
                Application.ActiveWorkbook.Close False
            Application.DisplayAlerts = True
            Application.ScreenUpdating = True
            MsgBox cnt & " Files saved to " & fldr
            MsgBox "No folder selected. "
        End If
        MsgBox "No sheets to save"
    End If
End Sub

This Code can also be found in an Xcessories AddIn for Excel which can be downloaded here.

Leave a Reply

%d bloggers like this: