Use vba to iterate through pivot items

[Trebormac]

Hi All,

I am using Excel 2003 and I have a pivot table with about 50 pivot items that I need to iterate through, making each one visiible individually , then copy the pivot table and paste it into a new workbook and the move on to the next pivot item and do the same.

When I execute the code I get this error message:
Run-time error '1004'
Unable to set the Visible property of the Pivot Item class.

Which occurs when trying to run


PivotItems(i).Visible = True

Option Explicit
Sub PivotStockItems()
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Country")
Dim i As Integer
For i = 2 To .PivotItems.Count
If .PivotItems(i).Visible = False Then
.PivotItems(i).Visible = True
.PivotItems(1).Visible = False
Cells.Select
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
.PivotItems(1).Visible = True
.PivotItems(i).Visible = False
End If
Next i
End With
End Sub

i would appreciate any suggestions.

Thanks,

Trebormac

 

[Centurion79b]

I am looking for ideas to speed up my code. I have code to loop through each sheet in an array and then select all items in the same pivot table on each sheet but turn off blanks. My code works but it takes almost 60 seconds to execute each sheet. Here is my code.

Dim ary As Variant, RVary As Variant
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer
ary = Array("CM PSL")
'ary = Array("CM PSL", "NM PSL", "CQ PSL", "NQ PSL", "CM Country", "NM Country", "CQ Country", "NQ Country", "QTR Summary", "TY PSL", "TY Country")
RVary = Array("CMRVCS", "NMRVCS", "CQRVCS", "NQRVCS")
Application.ScreenUpdating = False
On Error Resume Next
For Each i In ary
Sheets(i).Activate
    For Each j In RVary
        With ActiveSheet.PivotTables("RVCS")
            With .PivotFields(j)
                For k = 2 To .PivotItems.Count
                    .PivotItems(k).Visible = True
                Next k
                .PivotItems(1).Visible = False
            End With
        End With
    Next j
Next i

Thanks in advance for any suggestions.

 

[BKassem]

Hi Jerry,

I see your code the best on applying this, I was also struggling in emailing the generated sheets before they're saved and closed, could you please help me on how to do it?

I guess I should insert my VBA code to email it right after the paste command ?