Solved: Using Page Field to Create Multiple Sheets in Pivot Table

[Slicemahn]

Hello Everyone!

I need a second pair of eyes. I am trying to cycle through the items in my page field of the pivot table in order to create 7 seperate worksheets. When I execute the code only the first of the seven reveals data whereas the rest are blank. Could someone show me where I am wrong:

[VBA]Public Sub TollFreeCreatePivotTable()
Dim PTCache As PivotCache
Dim PT As PivotTable
Dim LastRow As Long
Dim LastCol As Long
Dim rngSource As Range
Dim Wks As Worksheet
Dim Wkr As Worksheet
Dim c As Integer

Application.ScreenUpdating = False

'Delete PivotSheet if it exists
On Error Resume Next
Application.DisplayAlerts = False

Sheets("Pivotdata").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Create a Pivot Cache
Set PTCache = ActiveWorkbook.PivotCaches.Add( _
SourceType:=xlDatabase, _
SourceData:=Sheets("tblCallFulfillment").Range("A1").CurrentRegion.Address)

'Add new worksheet
Set Wks = Worksheets.Add
Wks.Name = "Pivotdata"

'Create the pivot table from the cache
Set PT = PTCache.CreatePivotTable( _
TableDestination:=Wks.Range("A1"), _
TableName:="RorysPivot")

With PT
'Add fields
.AddFields RowFields:=Array("ProgramName", "Dialed Number", "ProgramLaunchDate", "ProgramEndDate", "Area_Code"), ColumnFields:="Date", PageFields:="LOB"
.PivotFields("Calls_Offered").Orientation = xlDataField
.TableRange1.EntireColumn.AutoFit
End With

PT.PivotSelect "'Dialed Number'[All;Total]", xlDataAndLabel, True
Selection.Delete
PT.PivotSelect "ProgramLaunchDate[All;Total]", xlDataAndLabel, True
Selection.Delete
PT.PivotSelect "ProgramEndDate[All;Total]", xlDataAndLabel, True
Selection.Delete

For c = 1 To PT.PivotFields("LOB").PivotItems.Count
PT.PivotFields("LOB").CurrentPage = PT.PivotFields("LOB").PivotItems(c).Name
PT.ManualUpdate = False
PT.ManualUpdate = True
ActiveWorkbook.Worksheets.Add
Sheets(c).Name = PT.PivotFields("LOB").PivotItems(c).Name
PT.TableRange2.Offset(1, 0).Copy
Sheets(c).Range("A3").PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Range("A3").Select
Next c



End Sub[/VBA]

[rory]

Since you named your pivot table after me, it's only fair I answer!
Your problem is the use of Sheets(c) - because you are adding sheets to the beginning of the workbook, sheets(c) always refers to the same sheet and you end up overwriting your data repeatedly. Try this:
[vba]Public Sub TollFreeCreatePivotTable()
Dim PTCache As PivotCache
Dim PT As PivotTable
Dim LastRow As Long
Dim LastCol As Long
Dim rngSource As Range
Dim Wks As Worksheet
Dim Wkr As Worksheet
Dim c As Integer

Application.ScreenUpdating = False

'Delete PivotSheet if it exists
On Error Resume Next
Application.DisplayAlerts = False

Sheets("Pivotdata").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Create a Pivot Cache
Set PTCache = ActiveWorkbook.PivotCaches.Add( _
SourceType:=xlDatabase, _
SourceData:=Sheets("tblCallFulfillment").Range("A1").CurrentRegion.Address)

'Add new worksheet
Set Wks = Worksheets.Add
Wks.Name = "Pivotdata"

'Create the pivot table from the cache
Set PT = PTCache.CreatePivotTable( _
TableDestination:=Wks.Range("A1"), _
TableName:="RorysPivot")

With PT
'Add fields
.AddFields RowFields:=Array("ProgramName", "Dialed Number", "ProgramLaunchDate", "ProgramEndDate", "Area_Code"), _
ColumnFields:="Date", PageFields:="LOB"
.PivotFields("Calls_Offered").Orientation = xlDataField
.TableRange1.EntireColumn.AutoFit

.PivotSelect "'Dialed Number'[All;Total]", xlDataAndLabel, True
Selection.Delete
.PivotSelect "ProgramLaunchDate[All;Total]", xlDataAndLabel, True
Selection.Delete
.PivotSelect "ProgramEndDate[All;Total]", xlDataAndLabel, True
Selection.Delete

For c = 1 To .PivotFields("LOB").PivotItems.Count
.PivotFields("LOB").CurrentPage = .PivotFields("LOB").PivotItems(c).Name
.ManualUpdate = False
.ManualUpdate = True
Set Wkr = ActiveWorkbook.Worksheets.Add
Wkr.Name = .PivotFields("LOB").PivotItems(c).Name
.TableRange2.Offset(1, 0).Copy
Wkr.Range("A3").PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Wkr.Range("A3").Select
Next c
End With

End Sub
[/vba]

[Slicemahn]

Very nice. Rory thanks a lot. I guess the With..End construct simplifies the code alot.

[rory]

Yup! You could also use the PivotTable's ShowPages method but that would create a new pivot table for each page item, rather than just a copy of the data.