How to Split Spreadsheets in Excel Using VBA

Contents

Why Separate Sheets?

An Excel workbook can have several worksheets. There’s a chance that those different sheets contain information that is unrelated and needs to be separated into separate workbooks.

Problem:

For example, imagine a corporate training hub preparing a document on training sessions planned in about 100 different locations. They might have offices at each location that plan and execute trainings after recruiting trainers and taking in admissions for new trainees.

If all the data prepared by the training hub sits in a single document with one sheet per location, it wouldn’t be right to send out the whole document to each location. Sensitive data needs to be removed for each location before sending out the document.

Each location is supposed to receive only location-relevant information. So, only the sheet containing the information relevant to their location should be sent out in a separate document.

Solution:

For this, it would be easier to separate the 100 sheets into 100 different documents and send out to the 100 locations. If done manually, it would be a very time consuming task. But what if a VBA code can be written to get this task done in a minute or less than that?

A Simple Example

Here is a workbook named “Holy temples” with three sheets of data inside. Each sheet has the list of temples in a particular location. My objective here is to split up the sheets into separate workbooks named after the same sheet. This would create one workbook for details on temples in one specific location.

An Excel workbook named “Holy temples” with three sheets of data inside.

Here is the code that will separate the sheets for us into standalone Excel documents. This should be written in the VBA/code window of the same workbook:

Sub Sep_Worksheets_demo()
' declare a variable to store the path of the opened workbook
Dim strFilePath As String

' assign values to the variable to math the file path
strFilePath = Application.ActiveWorkbook.Path

'You can turn this ScreenUpdating on ( true) / off (false) to see what is happening on the screen. Keeping it off can help in faster execution of code
Application.ScreenUpdating = False

' Display alerts are turned off in order to avoid any pop up alert msgs interrupting the execution.
Application.DisplayAlerts = False

' Loop to copy contents of each sheet and save it to a separate workbook
For Each ws In ThisWorkbook.Sheets
    ws.Copy
    Application.ActiveWorkbook.SaveAs Filename:=strFilePath &"\" & ws.Name & ".xlsx"
    Application.ActiveWorkbook.Close False
Next

' Enable alert msgs as execution is complete
Application.DisplayAlerts = True

' Enable screenupdating as execution is complete
Application.ScreenUpdating = True
End Sub

The code first gets the part of the open document and then starts executing a loop. Within the loop, it copies the context of each page one by one and saves it as a new book with the same name as the sheet then and there.

Then the loop ends.

The output of the code run is as below:

Output of code that separate sheets into standalone Excel documents.

Only three documents have been created as there were only three sheets in the main document.

You can use this piece of code for a variety of documents where you need to split up of the sheets into separate documents.

Spilt Data of One Sheet into Many Sheets

There may be a need where the data in one Excel spreadsheet is huge and needs to be split up into several sheets based on some criteria. Let’s take a look at the example below.

We have a list of books and authors in one sheet of an Excel document. This list of two columns has many books under each author. If we want the document to have one sheet of books per author, we will have to build logic where the data in the table is converted into several tables based on the author’s name. Each of these tables will have to go into separate sheets within the same document.

A list of books and authors split into two columns in an Excel document.
Sub Splitup_Sheets()


' Turn off continuous screen update display and pop up alerts
     Application.ScreenUpdating = False
     Application.DisplayAlerts = False
     
'Activate the sheet with data
    ThisWorkbook.Activate

    Sheets("Books and Authors").Activate

'clearing filter if any

    On Error Resume Next

    Sheets("Books and Authors").ShowAllData

    On Error GoTo 0

' declare variables to hold the last row and last col of the sheet with source data

    Dim lng_Col As Long
    Dim lng_Row As Long

    'counting last used row to assign value to last row variable

    lng_Row = Cells(Rows.Count, 1).End(xlUp).Row

    Dim uni_val As Range

    Dim str_col As String, lng_col_num As Long

    On Error GoTo error_handler

'Receive input col based on which the split up of data into sheets has to be done.

    str_col = Application.InputBox("Enter the column from based on which split up has to be done" & vbCrLf & "E.g. A, B, C, BW, ZA etc.")

    lng_col_num = Range(str_col & "1").Column

    Set uni_val = Range(str_col & "2:" & str_col & lng_Row)


'Calling function to Remove Duplicates and Get valu Names

    Set uni_val = RemoveDuplicates(uni_val)

' call the function to create sheets

    Call CreateSheets(uni_val, lng_col_num)

' set up application alert display settings

    With Application

        .ScreenUpdating = True

        .DisplayAlerts = True

        .AlertBeforeOverwriting = True

        .Calculation = xlCalculationAutomatic

    End With

    Sheets("Books and Authors").Activate

    MsgBox "Task Complete!"

    Exit Sub

    Data.ShowAllData

' the error handling block of code
error_handler:

    With Application

        .ScreenUpdating = True

        .DisplayAlerts = True

        .AlertBeforeOverwriting = True

        .Calculation = xlCalculationAutomatic

    End With


End Sub

Function RemoveDuplicates(uni_val As Range) As Range

ThisWorkbook.Activate

    ' add the new sheet and name it as in the input parameter
    Sheets.Add

    On Error Resume Next

    ActiveSheet.Name = "uni_val"

    Sheets("uni_val").Activate

    On Error GoTo 0
    
    ' Copy data from source

    uni_val.Copy
    
    ' select the destination cell and paste the copied data there

    Cells(2, 1).Activate

    ActiveCell.PasteSpecial xlPasteValues

    Range("A1").Value = "uni_val"

    'find the last row
    
    Dim lng_Row As Long

    lng_Row = Cells(Rows.Count, 1).End(xlUp).Row

    Range("A2:A" & lng_Row).Select

    ActiveSheet.Range(Selection.Address).RemoveDuplicates Columns:=1, Header:=xlNo

    lng_Row = Cells(Rows.Count, 1).End(xlUp).Row
    
    'Set the range in which duplicates need to be removed

    Set RemoveDuplicates = Range("A2:A" & lng_Row)

End Function

Sub CreateSheets(uni_val As Range, lng_col_num As Long)

' declare the variables to hold the last row num and col num

    Dim lng_Col As Long

    Dim lng_Row As Long

' iterate through the unique author names identified. This is passed on to this module as a range of values

    For Each valu In uni_val
    
    ' activate the main sheet of data

        Sheets("Books and Authors").Activate

' find the last row and last col of data and initialize the respective variables
        lng_Row = Cells(Rows.Count, 1).End(xlUp).Row
        lng_Col = Cells(1, Columns.Count).End(xlToLeft).Column

' create another range
        Dim dataSet As Range

        Set dataSet = Range(Cells(1, 1), Cells(lng_Row, lng_Col))

' filter the data based on the criteria- the specific author name as per the iteration
        dataSet.AutoFilter field:=lng_col_num, Criteria1:=valu.Value

        lng_Row = Cells(Rows.Count, 1).End(xlUp).Row

        lng_Col = Cells(1, Columns.Count).End(xlToLeft).Column
        
' display the row num and col num of the cell from which the author name is chosen for creation of a new sheet

        Debug.Print lng_Row; lng_Col
' initialize the created dataset

        Set dataSet = Range(Cells(1, 1), Cells(lng_Row, lng_Col))
' copy data from the main sheet
        dataSet.Copy

' add a new sheet
        Sheets.Add
' name it after the author
        ActiveSheet.Name = valu.Value2
' paste data to the newly created sheet
        ActiveCell.PasteSpecial xlPasteAll

' iterate to the next unique author name from the range ( the parameter passed here)
    Next valu

End Sub

What Does This Program Do?

Step 1

The program first creates a list of author names that are unique. It copies the author names col from the main sheet into a range object and removes duplicates from the list.

Step 2

A range is defined that can hold the list of unique author names. This is passed on to the “createsheets” function as a parameter.

Step 3

The createsheets function iterates through the range of unique authors.

Step 4

Within each iteration (of step 3), a filter is applied on the mainsheet for the author value of the specific iteration. Then, further, the last row and last column of the filtered data are identified, and the filtered data is copied.

A new sheet is created and named after the author for that iteration. The copied data is pasted into the newly created sheet.

This sheet creation and the copy-paste process repeats for each author in the range through each iteration of the for each loop.

In this way, separate sheets are created for each of the authors containing the information.

Output:

Output of the "createsheets" function
New sheet created from execution of function.

Conclusion

In this article, we have seen two ways of splitting data:

  1. Split sheets of a document into separate documents.
  2. Split data from one sheet into separate sheets.

Using the two methods above, one can also split the data of one sheet into several documents based on need. This can either be done using both the methods mentioned above/directly splitting the data of one sheet into several documents.

As usual, one must remember that actions done through the VBA code are not reversible. So, it is always better to have a backup of your document and code before you try your hand at techniques like this.

Leave a Reply

Your email address will not be published. Required fields are marked *