如何基于列将一个工作表拆分为多个工作簿

Question

我正在尝试获取一个主文档，并根据我的“业务单位”列中的值将其拆分为单独的excel文件。新工作表将以其业务部门命名，并且它们应仅包含包含该特定业务部门的行中的数据。 IE浏览器中所有带有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