VBA to create Multiple Pivots in different sheet based on one source

[Raghava@rock]

Hi Team ,

I am looking for help , in creating a code which will need to create the Pivots in different tabs from the Given data in Sheet1 based on the Month.

Appreciate you help in this regard.

Raghava.

 

[p45cal]

See attached which has a button to click in the vicinity of cell H3, which runs the following code:

Sub blah()
Set AWb = ActiveWorkbook
Set SceData = ActiveSheet.Range("A3").CurrentRegion
Set NewSht = AWb.Sheets.Add(after:=AWb.Sheets(AWb.Sheets.Count))
Set PC = AWb.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=SceData)
Set PT = PC.CreatePivotTable(TableDestination:=NewSht.Range("C4"))

With PT
  .AddFields "Name", , "Month "
  For Each PF In .PivotFields
  If PF.Orientation = xlHidden Then PF.Orientation = xlDataField
  Next PF
  Set PFM = .PivotFields("Month ")
  With PFM.PivotItems
  For i = 2 To .Count
  PFM.CurrentPage = .Item(i).Name
  Set WS = AWb.Sheets.Add(after:=AWb.Sheets(AWb.Sheets.Count))
  PT.TableRange2.Copy (WS.Range("C2"))
  Next i
  PFM.CurrentPage = .Item(1).Name
  End With
End With
PC.Refresh
End Sub

 

[Raghava@rock]

Hi p45cal ,

Thank you for the above code , However while I am adding couple more fields which i have added in the attached file. Can you help me in edit the code to chose the fields in Rows and in Datafeild .

I have attached a sample pivot in Sheet 1 T5 which is the lay out i am referring to.

Appreciate your help in this regard.
Regards
Raghava

 

[p45cal]

Sub blah()
Set AWb = ActiveWorkbook
Set SceData = ActiveSheet.Range("A3").CurrentRegion
Set NewSht = AWb.Sheets.Add(after:=AWb.Sheets(AWb.Sheets.Count))
Set PC = AWb.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=SceData)
Set PT = PC.CreatePivotTable(TableDestination:=NewSht.Range("C4"))

With PT
  .RowAxisLayout xlTabularRow
  .AddFields Array("Name", "Region ", "Scale"), , "Month "
  For Each PF In .PivotFields
    PF.Subtotals(1) = True
    PF.Subtotals(1) = False
  Next PF
  .AddDataField .PivotFields("Sales")
  .AddDataField .PivotFields("Revenue")
  .AddDataField .PivotFields("Collections")
  Set PFM = .PivotFields("Month ")
  With PFM.PivotItems
    For i = 2 To .Count
      PFM.CurrentPage = .Item(i).Name
      Set WS = AWb.Sheets.Add(after:=AWb.Sheets(AWb.Sheets.Count))
      PT.TableRange2.Copy (WS.Range("C2"))
    Next i
    PFM.CurrentPage = .Item(1).Name
  End With
End With
PC.Refresh
End Sub