Как отфильтровать сводные таблицы по значению ячейки в WKST 1 с помощью сводных таблиц в WKST 2. Как я могу изменить свой код?

Question

В настоящее время я фильтрую сводные таблицы по значению ячейки на листе 1, и это прекрасно работает.Однако я перенесу сводные таблицы на Рабочий лист 2 и сохраню только диаграммы для каждой таблицы на рабочем листе 1. Я хочу продолжать использовать значение ячейки из рабочего листа 1 для фильтрации.Я создаю свою панель инструментов на рабочем листе 1. Как я могу изменить свой код и предложения?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim pt As PivotTable
    Dim NewCat As String

    'if this is in the sheet1 code module you can use
    '  "Me" in place of "Worksheets("Sheet1")"
    NewCat = Worksheets("Sheet1").Range("H3").Value
    Debug.Print "Filtering on '" & NewCat & "'"
    'loop over all pivottables on the sheet
    For Each pt In Worksheets("Sheet1").PivotTables
        With pt.PivotFields("Customer Name")
           .ClearAllFilters
            .PivotFilters.Add Type:=xlCaptionEquals, Value1:=NewCat
        End With
    Next pt

End Sub

Answer 1

Итак, вопрос в том, когда вы хотите, чтобы код был запущен? В настоящее время он запускается, когда в листе есть событие «SelectionChange». Я предполагаю, что идея заключается в том, что он должен быть запущен после внесения изменений в сводные данные. Таким образом, этот код должен быть написан в Sheet2:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim pt As PivotTable
    Dim NewCat As String

    NewCat = Worksheets("Sheet2").Range("H3").Value
    For Each pt In Worksheets("Sheet2").PivotTables
        With pt.PivotFields("Customer Name")
            .ClearAllFilters
            .PivotFilters.Add Type:=xlCaptionEquals, Value1:=NewCat
        End With
    Next pt

End Sub

Чтобы код работал со всеми листами, просто скопировав и вставив его, рассмотрите возможность изменения Worksheets("Sheet2") с Me везде. Таким образом, Me относится к листу кода, в котором он находится. В случае выше Me = Worksheets("Sheets2").