Loop Through Pivot Table Page Field and return data

[ADeYoung]

Hello! I am missing something in my code and need a little assistance
I have a sheet (Item Lookup) that contains a pivot table with page fields and 6000 part numbers. I can manually select a part number, the pivot table will update the usage for that part, and do some other calculations on another sheet (LDY Test). I then want to copy those calculated values and paste on a "Results" sheet. I can get the loop to work up to the point where it copies the values on the LDY Test sheet, then it errors out. Not sure what I am doing wrong here.

Sub Loop_PivotItems()

Sheets("Item Lookup").Select
For Each PivotItem In ActiveSheet.PivotTables(1).PageFields(1).PivotItems

ActiveSheet.PivotTables(1).PageFields(1).CurrentPage = PivotItem.Value

Sheets("LDY Test").Range("B1:B6").Copy

Sheets("Results").Select
Range("A1").Select
For Z = 1 To 6500
ActiveCell.Offset(1, 0).Range("A1").Select

If ActiveCell.Value = "" Then
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=Flase, Transpose:=True
End If
Next Z

Next

End Sub

 

[Andrew Poulsom]

Why the loop For Z = 1 To 6500? You aren't using Z anywhere. Also you have SkipBlanks:=Flase. And you don't generally need to select objects to use their properties/methods.

 

[Domenic]

Why the loop For Z = 1 To 6500? You aren't using Z anywhere. Also you have SkipBlanks:=Flase. And you don't generally need to select objects to use their properties/methods.

If you're trying to copy each successive result to the first available row in the "Results" sheet, try...

Sub Loop_PivotItems()

    For Each PivotItem In Sheets("Item Lookup").PivotTables(1).PageFields(1).PivotItems
    
        Sheets("Item Lookup").PivotTables(1).PageFields(1).CurrentPage = PivotItem.Value
        
        Sheets("LDY Test").Range("B1:B6").Copy
        
        With Sheets("Results")
            .Cells(.Rows.Count, "A").End(xlUp)(2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        End With
    
    Next
    
    With Sheets("Results")
        .Select
        .Cells(1).Select
    End With


End Sub

 

[ADeYoung]

Thanks guys, I figured it out.

Sub Loop_PivotItems()


Application.ScreenUpdating = False

Sheets("Item Lookup").Select
For Each PivotItem In ActiveSheet.PivotTables(1).PageFields(1).PivotItems
ActiveSheet.PivotTables(1).PageFields(1).CurrentPage = PivotItem.Value

Sheets("LDY Test").Select
ActiveCell.Range("A1:A6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Results").Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Sheets("LDY Test").Select
' ActiveCell.Range("a1").Activate

Sheets("Item Lookup").Select

Next

Application.ScreenUpdating = True

End Sub