In this tutorial, we are going to write an automation script to split a table in Excel using VBA.
Using VBA, you can break down a source worksheet to multiple Excel file based on the values in the selected key columns, and doing so, will keep your data secure without oversharing unwanted information. Many solutions out there rely on 3rd party addins, require payment to download the software. With VBA, it is free, and you can modify the script to meet your specific need.
Check out Kite (free AI Coding Assistant) → Link
Buy Me a Coffee? Your support is much appreciated!
PayPal Me: https://www.paypal.me/jiejenn/5
Venmo: @Jie-Jenn
Download the source file → LINK
Download the final file → LINK
Source Code:
Option Explicit
Const Target_Folder As String = "<Target Folder Path>"
Dim wsSource As Worksheet, wsHelper As Worksheet
Dim LastRow As Long, LastColumn As Long
Sub SplitDataset()
Dim collectionUniqueList As Collection
Dim i As Long
Set collectionUniqueList = New Collection
Set wsSource = ThisWorkbook.Worksheets("Registered_Business_Locations_-")
Set wsHelper = ThisWorkbook.Worksheets("Helper")
wsHelper.Cells.ClearContents
With wsSource
.AutoFilterMode = False
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
LastColumn = .Cells(1, Columns.Count).End(xlToLeft).Column
If .Range("A2").Value = "" Then
GoTo Cleanup
End If
Call Init_Unique_List_Collection(collectionUniqueList, LastRow)
Application.DisplayAlerts = False
For i = 1 To collectionUniqueList.Count
SplitWorksheet (collectionUniqueList.Item(i))
Next i
ActiveSheet.AutoFilterMode = False
End With
Cleanup:
Application.DisplayAlerts = True
Set collectionUniqueList = Nothing
Set wsSource = Nothing
Set wsHelper = Nothing
End Sub
Private Sub Init_Unique_List_Collection(ByRef col As Collection, ByVal SourceWS_LastRow As Long)
Dim LastRow As Long, RowNumber As Long
wsSource.Range("G2:G" & SourceWS_LastRow).Copy wsHelper.Range("A1")
With wsHelper
If Len(Trim(.Range("A1").Value)) > 0 Then
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("A1:A" & LastRow).RemoveDuplicates 1, xlNo
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("A1:A" & LastRow).Sort .Range("A1"), Header:=xlNo
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
On Error Resume Next
For RowNumber = 1 To LastRow
col.Add .Cells(RowNumber, "A").Value, CStr(.Cells(RowNumber, "A").Value)
Next RowNumber
End If
End With
End Sub
Private Sub SplitWorksheet(ByVal Category_Name As Variant)
Dim wbTarget As Workbook
Set wbTarget = Workbooks.Add
With wsSource
With .Range(.Cells(1, 1), .Cells(LastRow, LastColumn))
.AutoFilter .Range("G1").Column, Category_Name
.Copy
wbTarget.Worksheets(1).Paste
wbTarget.Worksheets(1).Name = Category_Name
wbTarget.SaveAs Target_Folder & Category_Name & ".xlsx", 51
wbTarget.Close False
End With
End With
Set wbTarget = Nothing
End Sub
Hi Jie,
I would like to know how difficult would it be to recreate this same exercise but with additional 7 columns and assign them to the belonging folder (same name, organized with the same hierarchy).
Best,
A lifesaver! Thanks.
Glad my script helped!
That is great and saves so many hours of manual work!
I have two questions:
1. Assuming there are multiple spreadsheets in the file I’m using can the code be modified to save new files based on the column values in one sheet (as it does now) but then also save all other spreadsheets unchanged in new files?
2. How to modify the code to split based on a value in a column but also copy all rows below the table unchanged to new files
Enjoy the coffee 🙂
Hi Agata, can you send me an email to YouTube@LearnDataAnalysis.org with your question along with sample file illustrate the problem?
This I Great. How do i adjust to save it as CSV File?
I followed the tutorial and he enters in “.xlsx” in a section so maybe ctrl + f and replace as a different file type?
Hi!
I copied the script and ran it but a runtime error “1004: Clearcontents method of Range class failed. Why is that so and how do I solve it?
I copied the script into my file, did not download the source file.
“ClearContent”. Second C is capitalized.
I seem to be able to run the code, and the helper file lists my expected categories. However, no files are generated in my output folder. Any suggestions? I am trying to write to a network drive, although I don’t know why that would be an issue. Thanks in advance.
Is your file stored in One Drive?
This is excellent and really clear for a beginner such as myself.
Quick question, IF we wanted to retain the column length of the worksheet for the created worksheets, what would I need to add to the Macro?
Thanks
Can you be more specific?
Hi Jie,
This looks great. I’ve tried running but the output files are containing all of the source data rather than the filtered data by the category generated in the helper sheet. Any ideas what I’m doing wrong?
Thanks in advance.