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
- Find every unique value in the split column (Region).
- For each value: filter the data, copy the visible rows (with header) to a new workbook, save it, close it.
- 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
seenremembers what we've already added. (Many tutorials useScripting.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_COLto 2. - Different sheet: change
SHEET_NAME. - Sheets instead of files: replace the
Workbooks.Add … Closeblock withThisWorkbook.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).