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