'Option Explicit 'Приходы Sub ПриходСводТаб() Dim PTcache As PivotCache Dim pt As PivotTable Dim PItem As PivotItem Application.ScreenUpdating = False ' Удаление существующего листа сводной таблицы On Error Resume Next Application.DisplayAlerts = False Sheets("List8").Delete On Error GoTo 0 Worksheets.Add ActiveSheet.Name = "List8" ActiveWindow.DisplayGridlines = False ThisWorkbook.Sheets("List8").Select ' Создание кеэша сводной таблицы ActiveWorkbook.PivotCaches.Create( _ SourceType:=xlDatabase, _ SourceData:=ThisWorkbook.Sheets("Общая ОСВ").Range("B3").CurrentRegion.Address, _ Version:=xlPivotTableVersion10).CreatePivotTable _ TableDestination:=ThisWorkbook.Sheets("List8").Range("B3"), TableName:="BudgetPivot1", _ DefaultVersion:=xlPivotTableVersion10 ActiveSheet.PivotTables("BudgetPivot1").AddDataField ActiveSheet.PivotTables( _ "BudgetPivot1").PivotFields("ДебетК"), "Сумма по полю ДебетК", xlSum Set pt = ActiveSheet.PivotTables("BudgetPivot1") With pt 'Добавление полей ' .PivotFields("СчетД").Orientation = xlPageField ' .PivotFields("ДебетК").Orientation = xlPageField .PivotFields("ОСВ.00").Orientation = xlRowField .PivotFields("Дата").Orientation = xlColumnField ' .DisplayFieldCaptions = False End With With ActiveSheet.PivotTables("BudgetPivot1").PivotFields("ОСВ.00") 'pt.PageFields("ОСВ.00") For Each PItem In .PivotItems PItem.Visible = False If PItem.Name Like "76.05" Or PItem.Name Like "62.01" Then PItem.Visible = True Next End With End Sub