Saving a newly made sheet as an xlsx file in the same pathway as the file from which the sheet came.

ali1712 

Try this version:

Sub Split_data_macro()
    Dim L As Long
    Dim DS As Worksheet
    Dim X As Integer, Y As Integer
    Dim XCL As Long
    Dim MARY As Variant
    Dim title As String
    Dim titlerow As Integer
    Dim WB As Workbook
    Dim WS As Worksheet
    Dim Acct As String
    Dim sPath As String
    Application.ScreenUpdating = False
    sPath = ActiveWorkbook.Path
    If Right(sPath, 1) <> Application.PathSeparator Then
        sPath = sPath & Application.PathSeparator
    End If
    Set DS = ActiveSheet
    L = DS.Cells(DS.Rows.Count, 2).End(xlUp).Row
    title = "B1"
    titlerow = DS.Range(title).Cells(1).Row
    XCL = DS.Columns.Count
    DS.Cells(22, XCL) = "Unique"
    For Y = 2 To L
        DS.Cells(Y, 2) = Right(DS.Cells(Y, 2), 4)
    Next Y
    On Error Resume Next
    For X = 2 To L
        If DS.Cells(X, 2) <> "" And Application.WorksheetFunction.Match(DS.Cells(X, 2), DS.Columns(XCL), 0) = 0 Then
            DS.Cells(DS.Rows.Count, XCL).End(xlUp).Offset(1) = DS.Cells(X, 2)
        End If
    Next X
    MARY = Application.WorksheetFunction.Transpose(DS.Columns(XCL).SpecialCells(xlCellTypeConstants))
    DS.Columns(XCL).Clear
    For X = 2 To UBound(MARY)
        Acct = CStr(MARY(X))
        DS.Range(title).AutoFilter Field:=2, Criteria1:=Acct
        Set WB = Workbooks.Add(xlWBATWorksheet)
        Set WS = WB.Worksheets(1)
        WS.Name = Acct
        DS.Range("A" & titlerow & ":A" & L).EntireRow.Copy WS.Range("A1")
        WB.Close SaveChanges:=True, Filename:=sPath & Acct
    Next X
    DS.AutoFilterMode = False
    DS.Activate
    Application.ScreenUpdating = True
End Sub