Sub newPivot data_for_table As Worksheet report_1 As Workbook Диапазон

Sub newPivot(data_for_table As Worksheet, report_1 As Workbook)

' Диапазон данных
active_rows = data_for_table.Cells(1, 1).CurrentRegion.Rows.Count
active_columns = data_for_table.Cells(1, 1).CurrentRegion.Columns.Count
copy_region = "Лист1!" & Range(Cells(1, 1), Cells(active_rows, active_columns)).Address(ReferenceStyle:=xlR1C1)

' Вставка сводной таблицы
report_1.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=copy_region).CreatePivotTable TableDestination:="", TableName:="Table", DefaultVersion:=xlPivotTableVersion10
Set this_table = report_1.Sheets(1).PivotTables("Table")

' Добавление данных в сводную таблицу
With this_table.PivotFields("Компания")
    .Orientation = xlRowField
    .Position = 1
End With

this_table.AddDataField this_table.PivotFields("Итог"), "Сумма по полю Итог", xlSum

With this_table.PivotFields("Месяц")
    .Orientation = xlColumnField
    .Position = 1
    .NumberFormat = "[$-419]mmmm;@"
End With

End Sub
Sub Add()
Application.DisplayAlerts = False
Set currentWB = ActiveWorkbook
Path = ActiveWorkbook.Path
Set newWB = Application.Workbooks.Add
Dim plus_row As Integer

plus_row = 0
month_count = currentWB.Sheets.Count

' Добавляем шапку таблицы в новую книгу

Set Data = newWB.Sheets(1)
Data.Cells(1, 1).Value = "Компания"
Data.Cells(1, 2).Value = "Итог"
Data.Cells(1, 3).Value = "Месяц"

' Вставка данных со всех листоа текущей книги в Лист1 новой книги

For i = 1 To currentWB.Sheets.Count
    count_r = currentWB.Sheets(i).Cells(1, 1).CurrentRegion.Rows.Count
    month_name = currentWB.Sheets(i).Name
    For j = 2 + plus_row To count_r + plus_row
        Data.Cells(j, 1) = currentWB.Sheets(i).Cells(j - plus_row, 1)
        Data.Cells(j, 2) = currentWB.Sheets(i).Cells(j - plus_row, 2)
        Data.Cells(j, 3) = CDate("1 " & month_name)
        Data.Cells(j, 3).NumberFormat = "[$-419]mmmm;@"
    Next
    plus_row = count_r + plus_row - 1
Next

newWB.SaveAs (Path + "\" + "Данные")

' --------------------------------------------------------------Формирование Отчёта №1---------------------------------------------------------------------------------------------
newPivot newWB.Sheets(1), Application.Workbooks.Add

' Группировка по кварталам
ActiveSheet.PivotTables("Table").PivotSelect "Месяц", xlLabelOnly, True
Selection.Group Start:=True, End:=True, Periods:=Array(False, False, False, False, True, True, False)

' Сохранение текущего отчёта
ActiveWorkbook.SaveAs (Path + "\" + "Отчёт №1")

' --------------------------------------------------------------Формирование Отчёта №2---------------------------------------------------------------------------------------------
newPivot newWB.Sheets(1), Application.Workbooks.Add

' Список компаний и сумма заключенных с компанией договоров в процентом отношении к общей сумме
With ActiveSheet.PivotTables("Table").PivotFields("Сумма по полю Итог")
    .Calculation = xlPercentOfTotal
End With

' Группировка по кварталам
ActiveSheet.PivotTables("Table").PivotSelect "Месяц", xlLabelOnly, True
Selection.Group Start:=True, End:=True, Periods:=Array(False, False, False, False, True, True, False)

' Сохранение текущего отчёта
ActiveWorkbook.SaveAs (Path + "\" + "Отчёт №2")

' --------------------------------------------------------------Формирование Отчёта №3---------------------------------------------------------------------------------------------
newPivot newWB.Sheets(1), Application.Workbooks.Add

' Группировка по кварталам
ActiveSheet.PivotTables("Table").PivotSelect "Месяц", xlLabelOnly, True
Selection.Group Start:=True, End:=True, Periods:=Array(False, False, False, False, True, True, False)

' Сумма заключенных компанией договоров к текущему месяцу за весь истекший период (с нарастающим итогом в поле )
Range("C12").Select
    With ActiveSheet.PivotTables("Table").PivotFields("Сумма по полю Итог")
        .Calculation = xlRunningTotal
        .BaseField = "Месяц"
    End With
    
' Сохранение текущего отчёта
ActiveWorkbook.SaveAs (Path + "\" + "Отчёт №3")

' --------------------------------------------------------------Формирование Отчёта №4---------------------------------------------------------------------------------------------
newPivot newWB.Sheets(1), Application.Workbooks.Add

' Сравнение всех сумм заключенных договоров с компанией "Ракушка"
With ActiveSheet.PivotTables("Table").PivotFields("Сумма по полю Итог")
    .Calculation = xlDifferenceFrom
    .BaseItem = "Ракушка"
End With

' Группировка по кварталам
ActiveSheet.PivotTables("Table").PivotSelect "Месяц", xlLabelOnly, True
Selection.Group Start:=True, End:=True, Periods:=Array(False, False, False, False, True, True, False)

' Сохранение текущего отчёта
ActiveWorkbook.SaveAs (Path + "\" + "Отчёт №4")

End Sub