split excel workbook into separate workbook

Question

I have an excel file which contain over 20 worksheets and I understand how to split them into individual files and put their worksheet name as the new workbook name (.xlsx). Below is my vba code.

Sub Splitbook()

MyPath = ThisWorkbook.Path

For Each sht In ThisWorkbook.Sheets
    sht.Copy
    ActiveSheet.Cells.Copy
    ActiveSheet.Cells.PasteSpecialPaste:=xlPasteValues
    ActiveSheet.Cells.PasteSpecialPaste:=xlPasteFormats
    ActiveSheet.Cells.Hyperlinks.Delete
    ActiveWorkbook.SaveAs Filename:=MyPath & "\" & sht.Name & ".xlsx"
    ActiveWorkbook.Closesavechanges:=False
Next sht

End Sub

But now, I would like to make some changes.

More detail, My worksheet name as "NOTE", "JAN 16", "FEB 16"....etc

And I would split them as individual file but include the worksheet "NOTE".

which means worksheet "NOTE" + worksheet "JAN 16" --> new workbook name as "JAN 16" ; worksheet "NOTE" + worksheet "FEB 16" --> new workbook name as "FEB 16" ...etc

I have tried many times but have not been successful.

Please help... Thanks in advance.

what have you tried so far? what in particular is giving you trouble? — Mohammad Athar
i know how to split individual worksheet to individual workbook and put the worksheet name as new workbook name. But now I need to include the worksheet "NOTE" into each spliting workbook. I tried many time but not successful. — Ryan Tam
Look into Sheets("NAME").Move so the individual sheet moves out. The naming convention is similar to what you have, though you would use Filename:=MyPath & "\" & NOTE & " " & sht.Name & ".xlsx", where you Dim NOTE as String and capture the value. — Cyril

barvobot barvobot · Accepted Answer · 2017-10-23T19:00:57

See if this works for you. It copies the 'NOTE' sheet after the monthly sheet (JAN 16, etc.) but you can make it put the note before by taking out the comma (e.g. wNote.Copy ActiveWorkbook.Sheets(1)).

Sub SplitWorkbook()

Dim MyPath As String
Dim sht As Worksheet, wNote As Worksheet

On Error GoTo ErrorHandler

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set wNote = ThisWorkbook.Sheets("NOTE")

MyPath = ThisWorkbook.Path

For Each sht In ThisWorkbook.Sheets

    If sht.Name <> "NOTE" Then

        'copy the sheet in question (not giving a parameter copies it to a new wb)
        sht.Copy

        'apply formatting to sheet as desired (paste values, remove hyperlinks, etc.)
        ActiveSheet.Cells.Copy
        ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues
        ActiveSheet.Cells.Hyperlinks.Delete

        'copy note sheet after first sheet
        wNote.Copy , ActiveWorkbook.Sheets(1)

        'make sure new workbook shows the first sheet
        Application.Goto ActiveWorkbook.Sheets(1).Cells(1, 1)

        'save and close
        ActiveWorkbook.SaveAs Filename:=MyPath & "\" & sht.Name & ".xlsx"
        ActiveWorkbook.Close SaveChanges:=False

    End If

Next sht

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

Exit Sub

ErrorHandler:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Error # " & Err.Number & " - " & Err.Description, vbCritical, "Error"

Exit Sub

End Sub

split excel workbook into separate workbook

1 Answers