Разделить данные по нескольким книгам в зависимости от значения столбца

Question

У меня есть рабочая тетрадь, в которой содержится более 100 000 записей о потенциальных клиентах. Каждая запись имеет код агента, который определяет, кому эта запись предназначена (более 50 агентов). Что я хотел бы сделать, так это распределить все записи о потенциальных клиентах для каждого агента (книги) в зависимости от кода агента, сохраняя при этом существующее форматирование данных, проверку данных, а также автоматически создавая пароль рабочего листа. Возможно ли это с помощью excel VBA?

Таблица запускается в следующей последовательности:

введите описание изображения здесь

РЕДАКТИРОВАТЬ: Вот некоторые из примеров скрипты, которые мы запустили:

Sub ExtractToNewWorkbook()

    Dim ws     As Worksheet
    Dim wsNew  As Workbook
    Dim rData  As Range
    Dim rfl    As Range
    Dim state  As String
    Dim sfilename As String

    Set ws = ThisWorkbook.Sheets("emp")

    'Apply advance filter in your sheet

    With ws
        Set rData = .Range(.Cells(1, 1), .Cells(.Rows.Count, 11).End(xlUp))

        .Columns(.Columns.Count).Clear

        .Range(.Cells(2, 6), .Cells(.Rows.Count, 6).End(xlUp)).AdvancedFilter _
                        Action:=xlFilterCopy, _
                        CopyToRange:=.Cells(1, .Columns.Count), _
                        Unique:=True


        For Each rfl In .Range(.Cells(1, .Columns.Count), .Cells(.Rows.Count, .Columns.Count).End(xlUp))

             state = rfl.Text
             Set wsNew = Workbooks.Add

             sfilename = state & ".xlsx"

             'Set the Location
             ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & sfilename

             Application.DisplayAlerts = False
             ws.Activate

             rData.AutoFilter Field:=6, Criteria1:=state
             rData.Copy
             Windows(state).Activate
             ActiveSheet.Paste
             ActiveWorkbook.Close SaveChanges:=True

        Next rfl

        Application.DisplayAlerts = True

    End With

    ws.Columns(Columns.Count).ClearContents

    rData.AutoFilter

End Sub