Помогите новичку, плиз. Задача - сделать макросом для каждого менеджера (брика) свой отдельный лист с одной сводной таблицы. И переименовать каждый лист именем брика (ячейка B1)
Проблема - в том, что для троих менеджеров в тестовом режиме я макросы создал (см. вложенный файл), но в реальности их больше пятидесяти и каждый месяц некоторые их них будут менять название. Ручками, конечно, каждый раз править можно, но - не спортивно. (поиском некоторые примеры похожего решения находил, но что-то никак не подправлю под свои реалии).
Здравствуйте. А что обязательно нужно макросом, встроенные возможности Excel не устраивают? Активируйте любую ячейку сводной таблицы-- далее по вкладкам: Работа со сводными таблицами -- Параметры --- на треугольничек рядом с кнопкой Параметры -- Отобразить страницы фильтра отчета -- Ок. Макрорекордером получился такой макрос:
Код
Sub Макрос1()
ActiveSheet.PivotTables("Сводная таблица2").ShowPages PageField:="Брик"
End Sub
_Igor_61 написал: Вариант: сделать отдельно список всех менеджеров и пробежаться по нему циклом.
Спасибо. Как раз думал над таким вариантом. БОЖЕСТВЕННО! Большое спасибо.
Попробуем.
Цитата
А что обязательно нужно макросом, встроенные возможности Excel не устраивают?
Да, работает. Спасибо. Но прелесть макроса в том, что можно в него вставить доп.операции. Например, скопировать и вставить как значение (каждая закладка будет отдельным файлом и оправляться по почте каждому).
Запускать при активном листе Первичка, отдельные файлы по каждому менеджеру создаются в той же папке, где и исходный файл
Код
Sub Main()
Dim PRange As Range
Dim PTCache As PivotCache
Dim PT As PivotTable
Dim iLastRow As Long
Dim iLastCol As Integer
Dim WBN As Workbook
Dim WSh As Worksheet
iLastRow = Cells(Application.Rows.Count, 1).End(xlUp).Row - 1
iLastCol = Cells(1, Application.Columns.Count).End(xlToLeft).Column
Set PRange = Cells(1, 1).Resize(iLastRow, iLastCol)
Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=PRange.Address)
' Create the Pivot Table from the Pivot Cache
Set PT = PTCache.CreatePivotTable(TableDestination:=Cells(2, iLastCol + 2), TableName:="PivotTable1")
' Turn off updating while building the table
PT.ManualUpdate = True
' область строк и страницы
PT.AddFields RowFields:="Продукт", ColumnFields:="Данные", PageFields:="Брик"
' определяем область данных
With PT.PivotFields("для БТ")
.Orientation = xlDataField
.Function = xlSum
.Position = 1
.NumberFormat = "# ##0.00"
.Name = "сумма по полю для БТ"
End With
With PT.PivotFields("% от макс бон, руб.")
.Orientation = xlDataField
.Function = xlSum
.Position = 1
.NumberFormat = "# ##0.00"
.Name = "сумма по полю % от макс бон, руб."
End With
With PT.PivotFields("Факт уп")
.Orientation = xlDataField
.Function = xlSum
.Position = 1
.NumberFormat = "# ##0.00"
.Name = "сумма по полю Факт.уп"
End With
' Ensure that you get zeroes instead of blanks in the data area
PT.NullString = "0"
' Calc the pivot table
PT.ManualUpdate = False
PT.ManualUpdate = True
Dim iStr As Integer
Dim PivItem As Object
'цикл по значениям поля Брик
For Each PivItem In PT.PivotFields("Брик").PivotItems
PT.PivotFields("Брик").CurrentPage = PivItem.Name
'пересчитать сводную таблицу
PT.ManualUpdate = False
PT.ManualUpdate = True
Set WBN = Workbooks.Add(xlWBATWorksheet)
Set WSh = WBN.Worksheets(1)
WSh.Name = PivItem.Name
'копируем диапазон соответствующего менеджера
PT.TableRange2.Offset(3, 0).Copy
WSh.Range("A2").PasteSpecial xlPasteValuesAndNumberFormats
WBN.SaveAs Filename:=ThisWorkbook.Path & "\" & WSh.Name & ".xls"
WBN.Close SaveChanges:=True
Next
End Sub