Split one Excel sheet into multiple sheets by column value with VBA

A request I get every week: “I have one big sheet with all our orders. Can every salesperson get their own tab?” Doing it by hand means filtering, copying, pasting and renaming tabs again and again, and it has to be repeated every time the data changes. This macro does the whole job in a few seconds.

What the macro does

• Asks which column to split by, for example column C for Region.
• Finds every different value in that column.
• Creates one sheet per value and names it after the value.
• Copies the header row and all matching rows to each sheet, then auto-fits the columns.
• Runs again safely: an existing sheet with the same name is replaced, and your original sheet is never deleted.

Before you run it

• Your data must start in cell A1 with one header row and no completely empty columns in the middle.
• Sheet names cannot contain / ? * [ ] :, so the macro replaces those characters with a dash.
• Excel limits sheet names to 31 characters. Longer values are cut to fit.
• Rows with an empty value in the split column go to a sheet called Blank.

The macro

Option Explicit

' Split one sheet into separate sheets by the values in a column
' Free module from sourabsaha.com
'
' Select the sheet you want to split, run the macro and enter the column
' number to split by (A = 1, B = 2 ...). The data must start in A1 with
' one header row. Each value gets its own sheet with the header row on top.

Public Sub SplitSheetByColumn()
    Dim src As Worksheet, dest As Worksheet, keys As Object
    Dim colNum As Variant, lastRow As Long, lastCol As Long, r As Long
    Dim key As Variant, sheetName As String

    Set src = ActiveSheet
    colNum = Application.InputBox("Split by which column number? (A = 1, B = 2 ...)", "Split sheet", 1, Type:=1)
    If colNum = False Then Exit Sub

    lastRow = src.Cells(src.Rows.Count, colNum).End(xlUp).Row
    lastCol = src.Cells(1, src.Columns.Count).End(xlToLeft).Column
    If lastRow < 2 Then
        MsgBox "No data found below the header row.", vbExclamation
        Exit Sub
    End If

    Set keys = CreateObject("Scripting.Dictionary")
    For r = 2 To lastRow
        key = CStr(src.Cells(r, colNum).Value)
        If Len(key) = 0 Then key = "Blank"
        If Not keys.Exists(key) Then keys.Add key, key
    Next r

    Application.ScreenUpdating = False
    For Each key In keys.keys
        sheetName = Left(SafeSheetName(CStr(key)), 31)
        If LCase(sheetName) = LCase(src.Name) Then sheetName = Left(sheetName, 25) & " split"
        Application.DisplayAlerts = False
        On Error Resume Next
        ActiveWorkbook.Worksheets(sheetName).Delete
        On Error GoTo 0
        Application.DisplayAlerts = True

        Set dest = ActiveWorkbook.Worksheets.Add(After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count))
        dest.Name = sheetName
        src.Range(src.Cells(1, 1), src.Cells(lastRow, lastCol)).AutoFilter Field:=colNum, Criteria1:=IIf(key = "Blank", "=", key)
        src.Range(src.Cells(1, 1), src.Cells(lastRow, lastCol)).SpecialCells(xlCellTypeVisible).Copy dest.Range("A1")
        src.AutoFilterMode = False
        dest.Columns.AutoFit
    Next key
    src.Activate
    Application.ScreenUpdating = True
    MsgBox keys.Count & " sheet(s) created.", vbInformation
End Sub

Private Function SafeSheetName(ByVal txt As String) As String
    Dim bad As Variant
    For Each bad In Array("", "/", "?", "*", "[", "]", ":")
        txt = Replace(txt, bad, "-")
    Next bad
    SafeSheetName = txt
End Function

How it works

A Scripting.Dictionary collects each unique value once. For every value the macro applies AutoFilter on the chosen column and copies only the visible cells with SpecialCells(xlCellTypeVisible). Filtering and copying the visible block is much faster than looping through rows one by one, so it handles tens of thousands of rows comfortably.

Ideas to extend it

• Save each sheet as its own workbook and email it to the person it belongs to.
• Export each sheet to PDF for monthly statements.
• Add totals at the bottom of every new sheet.

All three are things I build for clients regularly. Send me your file if you want any of them added.

Free download

Download Split-Sheet-By-Column.bas

1. Open your workbook and press Alt + F11 to open the VBA editor.
2. Choose File, Import File and pick the downloaded .bas file.
3. Save the workbook as Excel Macro-Enabled Workbook (.xlsm).
4. Run the macro from Developer, Macros, or press Alt + F8.

Related guides

• Send personalised emails from Excel with Outlook
• Combine all CSV files in a folder into one sheet
• Lock and unlock every sheet with one button
• 12 Excel VBA macros that save hours every week

Need this built for your own workbook? I write splitting, merging and reporting macros for US businesses every week, tested on a copy of your file and delivered with a short how-to video. See my Excel VBA automation service or get a free quote in under a minute.