Set MyWorkbook= ActiveWorkbook : Set MySheet = ActiveSheet

MyWorkbook.Activate
MySheet.Activate

MyWorkbook.Select или Application.Window(MyWorkbook.Name).Activate

If ActiveWorkbook.PivotCaches.Count = 0 Then
    Dim objPivC As Excel.PivotCache
    Dim objPivT As Excel.PivotTable
    
    Set objPivC = ActiveWorkbook.PivotCaches.Create(xlExternal, , 4)
    Set objPivC.Recordset = rs
End If
Set ActiveWorkbook.PivotCaches(1).Recordset = rs
shSvod1.PivotTables("Pivot_table1").PivotCache.Refresh

Set shSvod1.PivotTables("pivot_table1").PivotCache.Recordset = rs

SELECT T1.*, 
     (SELECT TOP 1 sGroup FROM T2 WHERE T1.KOD=T2.KOD ORDER BY DateIn DESC) as GroupName
FROM T1

Dim pc as PivotCache
Dim rs as Recordset 'пробовал и ADODB.Recordset

pc = shSvod1.PivotTables("СводнаяТаблица1").PivotCache 'Ошибок нет
Set rs = pc.Recordset 'Ошибок нет
rs.MoveFirst 'Ошибка что объект не найден

Sub RefreshListBoxDate()
 Dim pt As PivotTable
 Dim pf As PivotField
 Dim iListV() As Variant
 Dim n, m, lV, lLB As Integer
 Dim s1, s2 As String Set pt = Worksheets("Свод_1").PivotTables("СводнаяТаблица2")
 Set pf = pt.PivotFields("[tbBasePLBS].[Дата].[Дата]")
 ListBox3.List = ModuleTools.Extract_Unique("tbBasePLBS", "Дата") 'Заполняем список уникальными значениями поля
 iListV = pf.VisibleItemsList lV = UBound(iListV)
 lLB = ListBox3.ListCount'Перебираем совпадения и отмечаем в списке отображаемые данные
For n = 1 To lLB
For m = 1 To lV
s1 = ModuleTools.ExtractValue(iListV(m)) 'извлекаем значение из строки фильтра и присваиваем переменной s1
s2 = ListBox3.List(n - 1)
If s1 = s2 Then ListBox3.Selected(n - 1) = True 'если значения в фильтре и списке совпали то отмечаем
Next m
Next n
End Sub

Function ExtractValue(iVal As Variant) As String
Dim iStarPos, iLenght As Integer
If iVal = Empty Then
    ExtractValue = ""
Else
    iStarPos = InStrRev(iVal, "[") + 1
    iLenght = Len(iVal) - iStarPos
    ExtractValue = Mid(iVal, iStarPos, iLenght)
End If
End Function

Function Extract_Unique(TableName, ColumnName As Variant) As Variant
    Dim vItem, avArr, li As Long
    Dim NameRange As String
    Dim myRange As Range
    
    ReDim avArr(1 To Rows.Count)
    
    NameRange = TableName & "[" & ColumnName & "]" 'формируем имя диапазона искомого столбца в заданой таблице
    Set myRange = Range(NameRange) 'присваиваем переменной искомый диапазон
         
    
    With New Collection
        On Error Resume Next
        For Each vItem In myRange.Value
            'Cells(Rows.Count, 1).End(xlUp) – определяет последнюю заполненную ячейку в столбце А
            .Add vItem, CStr(vItem)
            If Err = 0 Then
                li = li + 1: avArr(li) = vItem
            Else: Err.Clear
            End If
        Next
    End With
    ReDim Preserve avArr(1 To li)
    If li Then Extract_Unique = avArr
End Function

Sub RefreshListBoxDate()
 Dim pt As PivotTable
 Dim pf As PivotField
 Dim pi As PivotItems
 Dim s As StringSet pt = Worksheets("Свод_1").PivotTables("СводнаяТаблица2")
Set pf = pt.PivotFields("[tbBasePLBS].[Дата].[Дата]")
Set pi = pf.PivotItemsListBox3.List = Array()For i = 1 To pi.Count
s = pi(i).Value
MsgBox CStr(i) & ": " & s & ": Visible is " & CStr(pi(i).Visible)
ListBox3.AddItem
ListBox3.List(i - 1, 0) = ExtractValue(pi(i).Value)
ListBox3.Selected(i - 1) = pi(i).Visible ' Не работает - все значения True, хотя это не так
Next i
End Sub

Function ExtractValue(iVal As String) As String
   Dim iStarPos, iLenght As Integer
   
   iStarPos = InStrRev(iVal, "[") + 1
   iLenght = Len(iVal) - iStarPos
   ExtractValue = Mid(iVal, iStarPos, iLenght)
End Function

Function ExtractValue(iVal As String) As String
Dim iStarPos, iLenght As Integer
iStarPos = InStrRev(iVal, "[") + 1
iLenght = Len(iVal) - iStarPos
ExtractValue = Mid(iVal, iStarPos, iLenght)
End Function

Sub RefreshListBoxDate()
 Dim pt As PivotTable
 Dim pf As PivotField
 Dim pi As PivotItemsSet pt = Worksheets("Свод_1").PivotTables("СводнаяТаблица2")
Set pf = pt.PivotFields("[tbBasePLBS].[Дата].[Дата]")
Set pi = pf.PivotItems
ListBox3.List = Array()
For i = 1 To pi.Count
MsgBox CStr(i) & ": " & pi(i).Value & ": Visible is " & CStr(pi(i).Visible)
ListBox3.AddItem
ListBox3.List(i - 1, 0) = pi(i).Value 'Тут я поулчаю не чистое значение а еще имя таблицы и поля, что не нужно.
ListBox3.Selected(i - 1) = pi(i).Visible
Next i
End Sub

Private Sub UserForm_Initialize()
Call RefreshListBoxDate
End Sub 

Sub RefreshListBoxDate()
ListBox3.List = ModuleFilter.Extract_Unique("tbBasePLBS", "Дата")
With Worksheets("Свод_1").PivotTables("СводнаяТаблица2").PivotFields("[tbBasePLBS].[Дата].[Дата]")
For i = 1 To .PivotItems.Count
'MsgBox .PivotItems(i).Name & " Visible is " & CStr(.PivotItems(i).Visible)
ListBox3.Selected(i - 1) = .PivotItems(i).Visible
Next i
End With
End Sub

Sub btFilter_Click()
Dim iList()
Dim x As Integer
x = 0UserFormFilter1.Show
ReDim iList(UserFormFilter1.ListBox1.ListCount)For i = 0 To UserFormFilter1.ListBox1.ListCount - 1 Step 1
    
    If UserFormFilter1.ListBox1.Selected(i) Then
        iList(x) = "[tbBasePLBS].[Тип_отчетности].&[" & UserFormFilter1.ListBox1.List(i, 0) & "]"
        'MsgBox iList(x)
        x = x + 1
    End If
Next i
ReDim Preserve iList(x - 1)

ActiveSheet.PivotTables("СводнаяТаблица2").PivotFields( _
       "[tbBasePLBS].[Тип_отчетности].[Тип_отчетности]").VisibleItemsList = iList

End Sub

Sub Make_VisibleItems_Array()    Dim vVisibleList() As Variant, vPCodes As Variant
    Dim i As Long    

    vPCodes = Split("AB11,AB12,M2,M3,M4,M5,M6,M7,M8,M9,N1,N2,N3,N4,AB13", ",")     

    ReDim vVisibleList(LBound(vPCodes) To UBound(vPCodes))
    For i = LBound(vPCodes) To UBound(vPCodes)
        vVisibleList(i) = "[Postal District].[Postal District].&[" & vPCodes(i) & "]"
    Next i

    ActiveSheet.PivotTables("PivotTable6").PivotFields( _
        "[Postal District].[Postal District].[Postal District]") _
            .VisibleItemsList = vVisibleList
End Sub

Sub btFilter_Click()
Dim iList()
Dim x As Integer
x = 0

UserFormFilter1.Show
ReDim iList(UserFormFilter1.ListBox1.ListCount)

For i = 0 To UserFormFilter1.ListBox1.ListCount - 1 Step 1
    
    If UserFormFilter1.ListBox1.Selected(i) Then
        iList(x) = UserFormFilter1.ListBox1.List(i, 0)
        'MsgBox iList(x)
        x = x + 1
    End If
Next i

ReDim Preserve iList(x - 1)
ActiveSheet.PivotTables("СводнаяТаблица2").PivotFields( _
        "[tbBasePLBS].[Тип_отчетности].[Тип_отчетности]").VisibleItemsList = iList

End Sub

With ActiveSheet.PivotTables("СводнаяТаблица2")
'.ColumnGrand = Not .ColumnGrand 'Неправильно
.RowGrand = Not .RowGrand 'Правильно
End With

Sub swColumnGrand()
Dim Check As Boolean
Check = ActiveSheet.PivotTables("СводнаяТаблица2").ColumnGrand
'MsgBox (Check)
If Check Then
    ActiveSheet.PivotTables("СводнаяТаблица2").ColumnGrand = False 'Эта строка была создана макрорекордером когда руками включал/выключал итоги
        Else:
    ActiveSheet.PivotTables("СводнаяТаблица2").ColumnGrand = True
End If End Sub