How to Split Spreadsheets in Excel Using VBA
Why Separate Sheets?
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.
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.
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:
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.
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" &amp; vbCrLf &amp; "E.g. A, B, C, BW, ZA etc.") lng_col_num = Range(str_col &amp; "1").Column Set uni_val = Range(str_col &amp; "2:" &amp; str_col &amp; 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?
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.
A range is defined that can hold the list of unique author names. This is passed on to the “createsheets” function as a parameter.
The createsheets function iterates through the range of unique authors.
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.
In this article, we have seen two ways of splitting data:
- Split sheets of a document into separate documents.
- 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.