@RMedair
Here you go:
Sub SplitData()
' Target path, must end in \
Const strPath = "C:\Excel\"
' Column with Owner Names
Const NameCol = 2 ' column B
' Variables
Dim wshS As Worksheet
Dim wbkT As Workbook
Dim wshT As Worksheet
Dim lngLast As Long
Dim arr()
Dim r As Long
Dim col As Collection
Dim itm
' Turn off screen updating temporarily
Application.ScreenUpdating = False
' Refer to activesheet
Set wshS = ActiveSheet
' Last used row
lngLast = wshS.Cells(wshS.Rows.Count, NameCol).End(xlUp).Row
' Load values of name column into array
arr = wshS.Range(wshS.Cells(1, NameCol), wshS.Cells(lngLast, NameCol)).Value
' Create collection of unique names
Set col = New Collection
On Error Resume Next
For r = 2 To lngLast
col.Add Item:=arr(r, 1), Key:=CStr(arr(r, 1))
Next r
On Error GoTo 0
' Loop through the collection
For Each itm In col
' Create new workbook with one sheet
Set wbkT = Workbooks.Add(Template:=xlWBATWorksheet)
Set wshT = wbkT.Worksheets(1)
' Filter the data
wshS.UsedRange.AutoFilter Field:=NameCol, Criteria1:=itm
' Copy to new workbook
wshS.UsedRange.Copy Destination:=wshT.Cells(1, 1)
wbkT.SaveAs Filename:=strPath & itm & ".xlsx", FileFormat:=xlOpenXMLWorkbook
' Save and close new workbook
wbkT.Close SaveChanges:=False
Next itm
' Clean up
wshS.UsedRange.AutoFilter
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
