fx Practical VBA Projects

Sheet splitter — split one sheet into separate files by column value

⏱ 15 min

What you'll learn

  • The task
  • The plan
  • The code

Concept

1. The task

Sheet Data has sales for all regions. Every month you filter North, copy, paste into a new file, save as North.xlsx… and repeat for every region. The macro does it in seconds.

A B C D E
1 Date Salesperson Region Product Amount
2 01-Apr Amit North Laptop 55000
3 03-Apr Neha South Mobile 18000
… … … … … …

2. The plan

  1. Find every unique value in the split column (Region).
  2. For each value: filter the data, copy the visible rows (with header) to a new workbook, save it, close it.
  3. Restore everything and report how many files were made.

3. The code

Insert → Module and paste:

Option Explicit

Sub SplitByColumn()
    Const SHEET_NAME As String = "Data"
    Const KEY_COL As Long = 3                 ' column C = Region

    Dim ws As Worksheet, wbNew As Workbook
    Dim dataRng As Range
    Dim lastRow As Long, i As Long
    Dim folder As String, fileName As String
    Dim keys As Collection, k As Variant
    Dim seen As String

    On Error GoTo ErrHandler
    Set ws = ThisWorkbook.Worksheets(SHEET_NAME)
    lastRow = ws.Cells(ws.Rows.Count, KEY_COL).End(xlUp).Row
    If lastRow < 2 Then
        MsgBox "No data to split.", vbInformation
        Exit Sub
    End If
    Set dataRng = ws.Range("A1").CurrentRegion

    ' 1) Output folder next to this file
    folder = ThisWorkbook.Path & Application.PathSeparator & "Split_" & Format(Date, "yyyy-mm-dd")
    If Dir(folder, vbDirectory) = "" Then MkDir folder

    ' 2) Unique values (Collection works on Windows and Mac)
    Set keys = New Collection
    seen = "|"
    For i = 2 To lastRow
        k = Trim(CStr(ws.Cells(i, KEY_COL).Value))
        If Len(k) > 0 And InStr(1, seen, "|" & k & "|", vbTextCompare) = 0 Then
            keys.Add k
            seen = seen & k & "|"
        End If
    Next i

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    ' 3) One file per value
    For Each k In keys
        If ws.AutoFilterMode Then ws.AutoFilterMode = False
        dataRng.AutoFilter Field:=KEY_COL, Criteria1:=k

        Set wbNew = Workbooks.Add(xlWBATWorksheet)
        dataRng.SpecialCells(xlCellTypeVisible).Copy wbNew.Worksheets(1).Range("A1")
        With wbNew.Worksheets(1)
            .Name = Left(SafeName(CStr(k)), 31)
            .Rows(1).Font.Bold = True
            .Columns.AutoFit
        End With

        fileName = folder & Application.PathSeparator & SafeName(CStr(k)) & ".xlsx"
        wbNew.SaveAs fileName:=fileName, FileFormat:=xlOpenXMLWorkbook
        wbNew.Close SaveChanges:=False
    Next k

    MsgBox keys.Count & " files saved in:" & vbCrLf & folder, vbInformation

CleanExit:
    If ws.AutoFilterMode Then ws.AutoFilterMode = False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Exit Sub

ErrHandler:
    MsgBox "Split failed: " & Err.Description, vbExclamation
    Resume CleanExit
End Sub

' Removes characters that are not allowed in file or sheet names
Private Function SafeName(ByVal s As String) As String
    Dim ch As Variant
    For Each ch In Array("\", "/", ":", "*", "?", """", "<", ">", "|", "[", "]")
        s = Replace(s, ch, "-")
    Next ch
    SafeName = s
End Function

4. How it works

  • Unique values: a simple text list seen remembers what we've already added. (Many tutorials use Scripting.Dictionary, which is faster for huge lists but doesn't exist on Mac.)
  • AutoFilter + SpecialCells(xlCellTypeVisible): copies the header and only the matching rows.
  • Workbooks.Add(xlWBATWorksheet): a new file with exactly one sheet.
  • FileFormat:=xlOpenXMLWorkbook: saves as a normal .xlsx (no macros in the output).
  • SafeName: a region like "North/East" would break the file name; it becomes "North-East".
  • Dated folder: each run goes into Split_2026-10-01, so you never overwrite last month's files by accident.

5. Customise it

  • Split by Salesperson: change KEY_COL to 2.
  • Different sheet: change SHEET_NAME.
  • Sheets instead of files: replace the Workbooks.Add … Close block with ThisWorkbook.Worksheets.Add(After:=…) and paste there.
  • Keep values only: after copying, add wbNew.Worksheets(1).UsedRange.Value = wbNew.Worksheets(1).UsedRange.Value.

6. Add a button

Developer → Insert → Button (Form Control) → draw it → assign SplitByColumn. Now anyone can run it with one click.

Common mistakes

Running it before saving the master file (ThisWorkbook.Path is empty for a new unsaved file). Blank cells in the region column. Region names with / or : (handled by SafeName). Data that doesn't start at A1 (CurrentRegion picks the wrong block).

Exercises

mediumCreate 30 rows of sales data with 4 regions. Run the macro, open a couple of output files and check the counts against a filter in the master. Then change it to split by Salesperson and add the values-only line.
Use Sales: 30 rows split into North 8, South 8, East 7 and West 7. Each output must contain one header plus its region rows. Change the split column to Salesperson for 10 rows each for Asha, Ravi and Meera. After copying, assign outputRange.Value = outputRange.Value for values only; sanitize output filenames.

Quiz

What copies only the filtered rows?
SpecialCells(xlCellTypeVisible)
Why use a dated output folder?
So older files are never overwritten
Which line saves the new file as a normal .xlsx?
SaveAs with FileFormat:=xlOpenXMLWorkbook
Sheet splitter — split one sheet into separate files by column value · Automation | ExcelWalaa