Sub ShowRep()
Dim pt As PivotTable, i%, pf As PivotField, ws As Worksheet, _
pttemp As PivotTable, pf2 As PivotField, itar, sn
Set pt = ActiveSheet.PivotTables("PivotTable2") ' source pivot
If ActiveWorkbook.PivotCaches(pt.CacheIndex).OLAP Then MsgBox "OLAP table!"
Set pf = pt.PageFields(1) ' the page field
Set ws = ActiveWorkbook.Worksheets.Add ' add temp sheet
pf.Parent.TableRange2.Copy ws.[a1] ' copy table
Set pttemp = ws.Range("A1").PivotTable ' temp table
pttemp.PivotFields(pf.Name).CubeField.Orientation = xlRowField ' page field to row field
Set pf2 = pttemp.PivotFields(pf.Name)
ReDim itar(1 To pf2.PivotItems.Count)
For i = 1 To pf2.PivotItems.Count
itar(i) = pf2.PivotItems(i).Name ' array of items
Next
ws.Delete ' delete temp sheet
For i = LBound(itar) To UBound(itar) ' all items
Set ws = ActiveWorkbook.Worksheets.Add ' add sheet
pf.Parent.TableRange2.Copy ws.[a1] ' copy table
ws.[a1].PivotTable.PivotFields(pf.Name).CurrentPageName = itar(i)
sn = Split(itar(i), "&")
ws.Name = Replace(Replace(sn(UBound(sn)), "[", ""), "]", "")
Next
End Sub