Option Explicit

Private Sub CreatePivotTables(sh1 As Worksheet, sRang1 As String, sh2 As Worksheet, sRang2 As String)
Dim s As Worksheet, w As Workbook, r As Range
Dim sNamePivot As String
Set w = sh1.Parent
Set s = CheckSheet(w, "Проверочные сводные")
Set r = s.Range("A3")
' Делаем сводную по исходным данным
sNamePivot = "СводнаяТаблица_" + CStr(Now())

w.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
    sh1.Range(sRang1)).CreatePivotTable TableDestination:=r, _
    TableName:=sNamePivot, DefaultVersion:=xlPivotTableVersion10
'ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
'ActiveSheet.Cells(3, 1).Select
s.PivotTables(sNamePivot).AddFields RowFields:=Array( _
    "Месяц оплаты", "№ платежного поручения"), ColumnFields:= _
    "Принадлежность"
With s.PivotTables(sNamePivot).PivotFields( _
    "Разбивка оплаченных счетов")
    .Orientation = xlDataField
    .Function = xlSum
End With
Range("C5").Select
With s.PivotTables(sNamePivot).PivotFields( _
    "Сумма по полю Разбивка оплаченных счетов")
    .NumberFormat = "# ##0.00"
End With
Columns("C:C").ColumnWidth =  13 
Columns("D:D").ColumnWidth =  12 

' Делаем сводную по обработанным данным
Set r = Range("I3")

sNamePivot = "СводнаяТаблица_" + CStr(Now())

w.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
    sh2.Range(sRang2)).CreatePivotTable TableDestination:=r _
    , TableName:=sNamePivot, DefaultVersion:= _
    xlPivotTableVersion10
s.PivotTables(sNamePivot).AddFields RowFields:=Array( _
    "Месяц оплаты", "№ платежного поручения"), ColumnFields:= _
    "Принадлежность"
With s.PivotTables(sNamePivot).PivotFields( _
    "Разбивка оплаченных счетов")
    .Orientation = xlDataField
    .Function = xlSum
End With
'ActiveWindow.SmallScroll ToRight:=5
'Range("K6").Select
With s.PivotTables(sNamePivot).PivotFields( _
    "Сумма по полю Разбивка оплаченных счетов")
    .NumberFormat = "# ##0.00"
End With
Columns("K:K").ColumnWidth =  13 
Columns("L:L").ColumnWidth =  12 
' Ставим проверочные формулы на проверку соответствия сумм
Range("H5").FormulaR1C1 = "=RC[-3]-RC[5]"
Range("H5").Select
Selection.AutoFill Destination:=Range("F5:H5"), Type:=xlFillDefault
sNamePivot = ActiveCell.SpecialCells(xlLastCell).Row
Range("F5:H5").Select
Selection.AutoFill Destination:=Range("F5:H" + sNamePivot), Type:=xlFillDefault
Columns("H:H").ColumnWidth =  10 . 86 
End Sub

Private Function CheckSheet(w As Workbook, sName As String, Optional bReCreate As Boolean = True) As Worksheet
Dim b As Boolean
b = Application.DisplayAlerts
Application.DisplayAlerts = False
On Error GoTo labErr
' Если есть лист пытаемся удалить его
w.Sheets(sName).Delete
If bReCreate Then
' Если удалили и нужно создавать, создаем и возвращаем
    Set CheckSheet = w.Sheets.Add
    CheckSheet.Name = sName
End If
Application.DisplayAlerts = b
Exit Function
labErr:
Application.DisplayAlerts = b
If bReCreate Then
' Если нужно создавать, создаем и возвращаем
    Set CheckSheet = w.Sheets.Add
    CheckSheet.Name = sName
End If
End Function