У меня было три таблицы по первой сделан срез

В меню макросов в листе вставлен код по отслеживанию изменений на листе в срезе и потом если изменения есть запускается процедура по приведению других таблиц к срезу в первой

' Флаг для предотвращения рекурсии
Private IsSyncing As Boolean

' Переменная для хранения предыдущего состояния среза
Private previousSelectedValues As String

Private Sub Worksheet_Calculate()
    ' ЭТОТ КОД ДОЛЖЕН БЫТЬ В МОДУЛЕ ЛИСТА
    Dim sc As SlicerCache
    Set sc = ThisWorkbook.SlicerCaches("Срез_РЦ") ' Укажите имя вашего кэша
    
    If sc Is Nothing Then Exit Sub
    
    ' Получаем текущие выбранные значения
    Dim currentSelectedValues As String
    currentSelectedValues = GetSelectedSlicerItems(sc)
    
    ' Сравниваем с предыдущим состоянием
    If currentSelectedValues <> previousSelectedValues Then
        previousSelectedValues = currentSelectedValues
        
        ' Запускаем синхронизацию фильтров
        If Not IsSyncing Then
            IsSyncing = True
            СинхронизироватьФильтры
            IsSyncing = False
        End If
    End If
End Sub

Function GetSelectedSlicerItems(sc As SlicerCache) As String
    Dim result As String
    Dim si As SlicerItem
    
    For Each si In sc.SlicerItems
        If si.Selected Then
            result = result & si.Value & vbCrLf
        End If
    Next si
    
    GetSelectedSlicerItems = result
End Function

и потом с помощью процедуры в модуле вставлен код приведения срезов талбицы

' Этот код должен быть в ОБЫЧНОМ МОДУЛЕ (например, Module1)
Sub СинхронизироватьФильтры()
    ' Эта процедура отображается в списке макросов (Alt + F8)
    Dim sc As SlicerCache
    Set sc = ThisWorkbook.SlicerCaches("Срез_РЦ") ' Укажите имя кэша среза
    
    If Not sc Is Nothing Then
        ' Собираем выбранные элементы
        Dim selectedItems As Collection
        Set selectedItems = New Collection
        
        Dim si As SlicerItem
        For Each si In sc.SlicerItems
            If si.Selected Then selectedItems.Add si.Value
        Next si
        
        ' Применяем фильтры к таблицам
        ApplyFilterToTable "План", "РЦ", selectedItems
        ApplyFilterToTable "Выполнение", "РЦ", selectedItems
        
        'MsgBox "Фильтры синхронизированы!", vbInformation
    Else
        MsgBox "Срез не найден!", vbExclamation
    End If
End Sub

Sub ApplyFilterToTable(tableName As String, field As String, items As Collection)
    ' Процедура для фильтрации таблиц
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Показатели запрос") ' Укажите имя листа
    
    Dim lo As ListObject
    Set lo = ws.ListObjects(tableName)
    
    ' Находим индекс столбца
    Dim colIndex As Integer
    colIndex = lo.ListColumns(field).Index
    
    ' Снимаем текущий фильтр
    On Error Resume Next
    lo.Range.AutoFilter field:=colIndex
    On Error GoTo 0
    
    ' Применяем новый фильтр
    If items.Count > 0 Then
        Dim criteria() As String
        ReDim criteria(1 To items.Count)
        
        Dim i As Integer
        For i = 1 To items.Count
            criteria(i) = CStr(items(i))
        Next i
        
        ' Используем константу 7 (xlFilterValues для русской версии)
        lo.Range.AutoFilter _
            field:=colIndex, _
            Criteria1:=criteria, _
            Operator:=7
    End If
End Sub