Create a workbook from every worksheet in your workbook
Ron de Bruin (last update 11-June-2007)
Go back to the Excel tips page

This macro will copy every visible worksheet in a new workbook and save the workbook with the name of
the sheet in a newly created folder in the same path as the workbook with this macro.

Note: Working in Excel 97-2007

If you use Excel 2007 it will check the file format and will save the new files in the same format.
Only if it is a xlsm file and there is no code in the sheet module it will save it as xlsx.
Tip: Read also the information below the macro

Copy the macro below in a normal module of the workbook with the worksheets.
Sub Copy_Every_Sheet_To_New_Workbook()
'Working in 97-2007
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim sh As Worksheet
    Dim DateString As String
    Dim FolderName As String

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With

    'Copy every sheet from the workbook with this macro
    Set Sourcewb = ThisWorkbook

    'Create new folder to save the new files in
    DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
    FolderName = Sourcewb.Path & "\" & Sourcewb.Name & " " & DateString
    MkDir FolderName

    'Copy every visible sheet to a new workbook
    For Each sh In Sourcewb.Worksheets

        'If the sheet is visible then copy it to a new workbook
        If sh.Visible = -1 Then
            sh.Copy

            'Set Destwb to the new workbook
            Set Destwb = ActiveWorkbook

            'Determine the Excel version and file extension/format
            With Destwb
                If Val(Application.Version) < 12 Then
                    'You use Excel 97-2003
                    FileExtStr = ".xls": FileFormatNum = -4143
                Else
                    'You use Excel 2007
                    If Sourcewb.Name = .Name Then
                        MsgBox "Your answer is NO in the security dialog"
                        GoTo GoToNextSheet
                    Else
                        Select Case Sourcewb.FileFormat
                        Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                        Case 52:
                            If .HasVBProject Then
                                FileExtStr = ".xlsm": FileFormatNum = 52
                            Else
                                FileExtStr = ".xlsx": FileFormatNum = 51
                            End If
                        Case 56: FileExtStr = ".xls": FileFormatNum = 56
                        Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                        End Select
                    End If
                End If
            End With

            'Change all cells in the worksheet to values if you want
            If Destwb.Sheets(1).ProtectContents = False Then
                With Destwb.Sheets(1).UsedRange
                    .Cells.Copy
                    .Cells.PasteSpecial xlPasteValues
                    .Cells(1).Select
                End With
                Application.CutCopyMode = False
            End If


            'Save the new workbook and close it
            With Destwb
                .SaveAs FolderName _
                      & "\" & Destwb.Sheets(1).Name & FileExtStr, _
                        FileFormat:=FileFormatNum
                .Close False
            End With

        End If
GoToNextSheet:
    Next sh

    MsgBox "You can find the files in " & FolderName

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

Information

If you run the code in Excel 2007 it will look at the FileFormat of the parent workbook and
save the new file in that format.
Only if the parent workbook is an xlsm file and if there is no code in the new workbook it will
save the new file as xlsx, If the parent workbook is not an xlsx, xlsm, or xls then it will be saved as xlsb.

This are the main formats in Excel 2007 :

51 = xlOpenXMLWorkbook (without macro's in 2007, xlsx)
52 = xlOpenXMLWorkbookMacroEnabled (with or without macro's in 2007, xlsm)
50 = xlExcel12 (Excel Binary Workbook in 2007 with or without macro’s, xlsb)
56 = xlExcel8 (97-2003 format in Excel 2007, xls)

If you always want to save in a certain format you can replace this part of the macro
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select

With one of the one liners from this list

FileExtStr = ".xlsb": FileFormatNum = 50
FileExtStr = ".xlsx": FileFormatNum = 51
FileExtStr = ".xlsm": FileFormatNum = 52
FileExtStr = ".xls": FileFormatNum = 56



Or maye you want to save the one sheet workbook to csv, txt or prn.
(you can use this also if you run it in 97-2003)

FileExtStr = ".csv": FileFormatNum = 6
FileExtStr = ".txt": FileFormatNum = -4158
FileExtStr = ".prn": FileFormatNum = 36