Split Sheet by Column Value

Attribute VB_Name = "SplitSheetByColumnValue"
Option Explicit

Public Sub SplitSheetByColumnValue()
    Dim srcWs As Worksheet
    Dim lastRow As Long, r As Long
    Dim key As String
    Dim destWs As Worksheet
    Dim headerRow As Range

    Set srcWs = ActiveSheet
    lastRow = srcWs.Cells(srcWs.Rows.Count, 1).End(xlUp).Row
    Set headerRow = srcWs.Rows(1)

    Application.ScreenUpdating = False

    For r = 2 To lastRow
        key = CStr(srcWs.Cells(r, 1).Value)
        If key = "" Then GoTo NextRow

        If Not SheetExists(key) Then
            Set destWs = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
            destWs.Name = Left(SanitizeSheetName(key), 31)
            headerRow.Copy destWs.Rows(1)
        Else
            Set destWs = ThisWorkbook.Worksheets(Left(SanitizeSheetName(key), 31))
        End If

        srcWs.Rows(r).Copy destWs.Rows(destWs.Cells(destWs.Rows.Count, 1).End(xlUp).Row + 1)
NextRow:
    Next r

    Application.ScreenUpdating = True
    MsgBox "Split complete.", vbInformation
End Sub

Private Function SheetExists(name As String) As Boolean
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = ThisWorkbook.Worksheets(Left(SanitizeSheetName(name), 31))
    SheetExists = Not ws Is Nothing
    On Error GoTo 0
End Function

Private Function SanitizeSheetName(name As String) As String
    Dim invalidChars As Variant, ch As Variant
    invalidChars = Array("\", "/", "?", "*", "[", "]", ":")
    For Each ch In invalidChars
        name = Replace(name, ch, "_")
    Next ch
    SanitizeSheetName = name
End Function