automatic update in other sheets: need some changes to the existing code

 Sub TestIt()
Dim sWS     As Worksheet
Dim Sellers As Range, Seller    As Range
Dim lRow    As Long, fRow       As Integer
Dim CopyRng As Range, ws        As Worksheet

Set sWS = Worksheets("Data")
lRow = sWS.Range("A" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    sWS.Columns(1).Insert
    sWS.Range("B1:B" & lRow).AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=sWS.Range("A1"), Unique:=True
fRow = sWS.Range("A" & Rows.Count).End(xlUp).Row
Set Sellers = sWS.Range("A2:A" & fRow)
    For Each Seller In Sellers
        With sWS.Range("B1:B" & lRow)
            .AutoFilter Field:=1, Criteria1:=Seller
            Set CopyRng = .Offset(0, 0).Resize(.Rows.Count, Columns.Count - 1). _
                SpecialCells(xlCellTypeVisible)
            On Error Resume Next
            Set ws = Sheets(Seller.Value)
            On Error GoTo 0
            If Not ws Is Nothing Then
                CopyRng.Copy
                ws.Range("A1").PasteSpecial xlPasteValues
            Else
                Set ws = Sheets.Add
                ws.Name = Seller.Value
                CopyRng.Copy
                ws.Range("A1").PasteSpecial xlPasteValues
            End If
            .AutoFilter
        End With
        Set ws = Nothing
        Set CopyRng = Nothing
    Next Seller
    sWS.Columns(1).Delete
    Application.ScreenUpdating = True
End Sub