Процедура работы со сводными таблицами

'Option Explicit
'Приходы

Sub main()
'   Удаление существующего листа сводной таблицы

  Call UPT("ЛистСВОД", "Лист1", "B3", "A1", "SvodT1", "ДебетО", "60.01")
'  Call UPT("ЛистСВОД", "Лист1", "B3", "A10", "SvodT2", "ДебетК", "62.01")
'  Call UPT("ЛистСВОД", "Лист1", "B3", "A15", "SvodT3", "ДебетК", "76.05")
End Sub

Sub dddd(sdsd As Integer, _
          fdfdf As Integer)
          MsgBox sdsd + fdfdf
          End Sub

Sub UPT(SourseList As String, _
        PVTList As String, _
        FirstRangeSL As String, _
        SecondRange As String, _
        TableName1 As String, _
        SummaPo As String, _
        SortBy As String)

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

        

Sub ПриходСводТаб()
    Dim PTcache As PivotCache
    Dim pt As PivotTable
    Dim PItem As PivotItem
    Dim Sname As String
    
    Sname = "ЛистСВОД"
 
    Application.ScreenUpdating = False
'   Удаление существующего листа сводной таблицы
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets(Sname).Delete
    On Error GoTo 0
 
    Worksheets.Add
    ActiveSheet.Name = Sname
    ActiveWindow.DisplayGridlines = False
 
 ThisWorkbook.Sheets(Sname).Select
 
 
'   Создание кеэша сводной таблицы
     ActiveWorkbook.PivotCaches.Create( _
      SourceType:=xlDatabase, _
      SourceData:=ThisWorkbook.Sheets("Лист1").Range("B3").CurrentRegion.Address, _
      Version:=xlPivotTableVersion10).CreatePivotTable _
        TableDestination:=ThisWorkbook.Sheets(Sname).Range("B1"), 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