welcome to the forum.
ggiybf here.
here is one solution
Sub test()
'https://www.ozgrid.com/forum/forum/help-forums/excel-general/139918-split-data-into-separate-worksheets-based-on-values-in-column-a
Dim e
With Sheets("Sheet1").Cells(1).CurrentRegion
.Parent.AutoFilterMode = False
For Each e In Filter(.Parent.[Transpose(If(CountIf(Offset(B2:B10000,,,Row(1:10000)),B2:B10000)=1,B2:B10000,Char(2)))], Chr(2), 0)
If Not SheetExists(e) Then Sheets.Add(after:=Sheets(Sheets.Count)).Name = e
Sheets(e).Cells.Delete
.AutoFilter 1, e
.Copy Sheets(e).Cells(1)
.AutoFilter
Next
End With
End Sub
Function SheetExists(ByVal txt As String) As Boolean
On Error Resume Next
SheetExists = Len(Sheets(txt).Name)
On Error GoTo 0
End Function