Split Rows For Unique Values In A Column To Different Workbooks

Hi

Iam trying to segregate data based on the cell value(which is a Text) in a Column, cell value is repeated many times in the column. Iam trying to copy the entire row and all rows with same value into a new workbook with the cell value as name of the new sheet.

I did search and got below code, but it is not working properly.As I am new to coding I am not able to understand what is incorrect.

Can someone please suggest me what change is to be made and also add comments.

The column in my case is column number 33 which is AG and values are added from AG2.

Thanks.

Sub FileDecimator()
    Dim varValue
    Dim lngRow As Long: lngRow = 1
    Dim rngToCopy As Range
     
    Dim wbk As Workbook
    With ActiveWorkbook.Worksheets("PID_ELTO").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("AG2").CurrentRegion.Columns(33), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("AG2").CurrentRegion
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
     
    Do While Not IsEmpty(Cells(lngRow, 33))
        With ThisWorkbook.Worksheets("PID_ELTO")
            Set rngToCopy = .Range(.Cells(lngRow, 1), .Columns(33).Find(What:=varValue, LookAt:=xlWhole, SearchDirection:=xlPrevious).Offset(, 2))
            varValue = .Cells(lngRow, 1).Value
        End With
        Set wbk = Workbooks.Add(xlWorksheet)
        With wbk
            .Sheets(1).Cells(1).Resize(rngToCopy.Rows.Count, rngToCopy.Columns.Count).Value = rngToCopy.Value
            .SaveAs ThisWorkbook.Path & "\" & varValue
            .Close 0
        End With
        lngRow = lngRow + rngToCopy.Rows.Count
        Set wbk = Nothing
        Set rngToCopy = Nothing
    Loop
     
End Sub