Как разбить одну рабочую таблицу на несколько рабочих книг на основе столбца

Question

Я пытаюсь взять один мастер-документ и разделить его на отдельные файлы Excel на основе значений в моем столбце «Бизнес-единица». Новые листы будут названы в честь их бизнес-единицы, и они должны содержать только данные в строках, содержащих эту конкретную бизнес-единицу. То есть все строки, помеченные ACH, должны находиться в новой папке ach. Этот код в настоящее время делает листы на основе сегмента "столбец A". Кроме того, я получаю данные только в тех строках, которые соответствуют имени сегмента IE, вместо того, чтобы получать ACH ACH и ACH ACH 1 ACH ACH2 Я просто получаю ACH ACH. Поэтому я либо настроил свою фильтрацию неправильно, либо я настроил свое копирование неправильно , Я просто не могу сказать.

Sub ExtractToNewWorkbook()

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

    Set ws = ThisWorkbook.Sheets("All Functions Final")

    'Apply advance filter in sheet

    With ws

        Set rData = .Range(.Cells(1, 1), .Cells(.Rows.Count, 10).End(xlUp))
        .Columns(.Columns.Count).Clear
        .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).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))

            Business_Unit = rfl.Text

            Set wsNew = Workbooks.Add

            sfilename = Business_Unit & ".xlsx"

            'Set the Location

            ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & sfilename
            Application.DisplayAlerts = False
            ws.Activate
            rData.AutoFilter Field:=2, Criteria1:=Business_Unit
            rData.Copy
            Windows(Business_Unit).Activate
            ActiveSheet.Paste
            ActiveWorkbook.Close SaveChanges:=True

        Next rfl

        Application.DisplayAlerts = True

    End With

    ws.Columns(Columns.Count).ClearContents
    rData.AutoFilter

End Sub