Macro to Split Data Onto Separate Sheets

Try this

Option Explicit

Sub test()
    Dim x, y, e
    Application.ScreenUpdating = False
    With Sheets("source data").Range("a1").CurrentRegion
        .Parent.AutoFilterMode = False
        With .Columns(1).Resize(.Rows.Count - 1).Offset(1)
            x = .Address
            .Value = .Parent.Evaluate("if(" & x & "<>"""",trim(" & x & "),"""")")
            y = Filter(Evaluate("transpose(if(countif(offset(" & x & _
            ",0,0,row(1:" & .Rows.Count & "))," & x & ")=1," & x & ",char(2)))"), Chr(2), 0)
        End With
        For Each e In y
            If Not IsSheetExists(CStr(e)) Then
                Sheets.Add(after:=Sheets(Sheets.Count)).Name = e
            End If
            Sheets(CStr(e)).Cells.Clear
            .AutoFilter 1, e
            .Copy Sheets(e).Cells(1)
            Sheets(e).Range("a1").CurrentRegion.Columns.AutoFit
            .AutoFilter
        Next
    End With
    Application.ScreenUpdating = True
End Sub

Function IsSheetExists(ByVal txt As String) As Boolean
    On Error Resume Next
    IsSheetExists = Len(Sheets(txt).Name)
    On Error GoTo 0
End Function