Создание сводных таблиц в цикле, каждый на своем собственном новом листе с динамическим именем VBA

Question

Вот что я хочу код, чтобы сделать

для каждой строки в колонке U создать новую вкладку с новым стержнем таблица на основе данных рабочего листа

Проблема заключается в том, что место для динамической таблицы я считаю. Я создаю переменную PayorName, которая основана на списке на листе «Мастер». то я хочу, чтобы листы, основанные на сводных таблицах, имели название «[компания] Pivot»

Я пытаюсь сделать слишком много сразу?

Частичный код:

Dim LastRowA As Long 
With ActiveSheet 
    LastRowA = .Cells(.Rows.Count, "A").End(xlUp).Row 
End With 
Dim LastRowU As Long 
With ActiveSheet 
    LastRowU = .Cells(.Rows.Count, "U").End(xlUp).Row 
End With 


ActiveSheet.Name = "Master" 

'this loop is set to run the first 5 items temporarily 
'later it will go to lastrowU 
For i = 2 To 5 

PayorName = Sheets("Master").Cells(i, "U").Value 

Sheets.Add 
ActiveSheet.Name = PayorName & " Pivot" 
With ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ 
     "Master1!R1C1:R" & LastRowA) 
     .CreatePivotTable TableDestination:=Sheets(PayorName & " Pivot").Range("A3"), TableName:="PivotTable" 
End With 
    Sheets(PayorName & " Pivot").Select 
    Cells(3, 1).Select 
    ' from here I set the pivot's fields 
next i 

Answer 1

Может быть, что кэш поворота слишком велик, чтобы сделать динамически? Я попробовал этот код и получить сообщение об ошибке при попытке установить кэш поворота

Dim FinalRow   As Long 
Dim DataSheet   As String 
Dim PvtCache   As PivotCache 
Dim PvtTbl    As PivotTable 
Dim DataRng    As Range 
Dim TableDest   As Range 

Dim LastCol As Integer 
    With ActiveSheet 
     LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column 
    End With 
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row 
DataSheet = ActiveSheet.Name 

' set data range for Pivot Table 
Set DataRng = Sheets(DataSheet).Range(Cells(1, 1), Cells(FinalRow, LastCol)) 
' set pivot cache 
Set PvtCache = ActiveWorkbook.PivotCaches.Add(xlDatabase, DataRng) 

Тогда возникает ошибка (тип несовпадение) на последнюю строку (набор pvtcache ...), но код продолжается такие как

PayorName = Sheets("Master1").Cells(i, "U").Value 

Sheets.Add 
ActiveSheet.Name = PayorName & " Pivot" 

' set range for Pivot table placement 
Set TableDest = Sheets(PayorName & " Pivot").Cells(3, 1) 



' this line in case the Pivot table doesn't exit >> first time running this Macro 
On Error Resume Next 
Set PvtTbl = ActiveWorkbook.Sheets(DataSheet).PivotTables("PivotTable") ' check if "PivotTable4" Pivot Table already created (in past runs of this Macro) 

On Error GoTo 0 
If PvtTbl Is Nothing Then ' "PivotTable" doesn't exist >> create it 

    ' create a new Pivot Table in "PivotTable" sheet 
    Set PvtTbl = ActiveWorkbook.Sheets(DataSheet).PivotTables.Add(PivotCache:=PvtCache, TableDestination:=TableDest, TableName:="PivotTable") 

    ' setting fields 
    ActiveSheet.PivotTables("PivotTable").AddDataField ActiveSheet.PivotTables(_ 
      "PivotTable1").PivotFields("Amount"), "Sum of Amount", xlSum 
     With ActiveSheet.PivotTables("PivotTable1").PivotFields("Sum of Amount") 
      .NumberFormat = "$#,##0.00_);($#,##0.00)" 
     End With 
     With ActiveSheet.PivotTables("PivotTable").PivotFields("GL Debit Account") 
      .Orientation = xlColumnField 
      .Position = 1 
     End With 
     With ActiveSheet.PivotTables("PivotTable").PivotFields("Payment Payor") 
      .Orientation = xlRowField 
      .Position = 1 
     For x = 1 To .PivotItems.Count - 1 
      .PivotItems(.PivotItems(x).Name).Visible = False 
     Next x 
     .PivotItems(PayorName).Visible = True 
     End With 
     With ActiveSheet.PivotTables("PivotTable").PivotFields("Post Date") 
      .Orientation = xlRowField 
      .Position = 2 
     End With 
     With ActiveSheet.PivotTables("PivotTable").PivotFields("Batch #") 
      .Orientation = xlRowField 
      .Position = 3 
     End With 
End If