将筛选的数据复制到新工作簿（同时创建新工作簿），并将该名称保存为Pivot中的筛选值

Question

我有一个Excel文件，创建了Pivot和两个过滤器（名称和日期），当我按名称筛选时

我想筛选每个名称，并使用该名称创建一个新工作簿（filtername），然后将筛选后的数据粘贴到其中。一次筛选中只能有一个名称

我试过这个密码

Sub arcpivot3()
    Dim myPivotField As PivotField
    Dim filterValue As String
    Dim vendorname As String
    Dim myString As String
    Dim a As String
    Dim k As String
    Dim name As String
    Dim wkb As Workbook

    Dim fp As Worksheet
    Dim vr As Worksheet
    Dim temp, ALastRow, BLastRow As Integer
    Dim VendorNamesArray(100) As String
    Dim VendorNames(1000) As String

    Set fp = Worksheets("3rd Pivot")
        
    ALastRow = fp.Range("A" & Rows.Count).End(xlUp).Row
    Sheets("3rd Pivot").PivotTables("secondpivot_table").PivotCache.Refresh
    Application.ScreenUpdating = False

    Dim ws As Worksheet
    Dim wq As Worksheet

    Set ws = Worksheets("3rd Pivot")
    Dim pt As PivotTable
    Set pt = ws.PivotTables("secondpivot_table")
    Dim pF As PivotField
    Set pF = pt.PivotFields("Principal Vendor Name")
    pF.EnableMultiplePageItems = True
    pF.CurrentPage = "(All)"
        
        
    For i = 1 To pF.PivotItems.Count
    k = i
    For j = 1 To pF.PivotItems.Count
    If i = j Then
    pF.PivotItems(i).Visible = True
    VendorNames(i) = pF.PivotItems(i).name
    a = pF.PivotItems(i).name
    Set wkb = Workbooks.Add
    wkb.SaveAs "E:\ARC master\" & a & ".xlsx"
    Else:
    pF.PivotItems(j).Visible = False
    End If
        Next j
        Next i

End Sub