USE Vba to Iterate through Pivot Table while copying single field into separate sheet

Question

I am using Excel 2013 and I have a pivot table with hundreds of filter values that I need to iterate through, making each one visiible individually , then copy the filtered value, and a specific cell (non-Pivot, and IF >0) and paste it (values only) into a specified sheet and the move on to the next pivot item and do the same. I found some code that is similar to what I want

Sub PivotStockItems()
Dim i As Integer
Dim sItem As String
Application.ScreenUpdating = False
With ActiveSheet.PivotTables("PivotTable1")
    .PivotCache.MissingItemsLimit = xlMissingItemsNone
    .PivotCache.Refresh
    With .PivotFields("Country")
        '---hide all items except item 1
        .PivotItems(1).Visible = True
        For i = 2 To .PivotItems.Count
            .PivotItems(i).Visible = False
        Next
        For i = 1 To .PivotItems.Count
            .PivotItems(i).Visible = True
            If i <> 1 Then .PivotItems(i - 1).Visible = False
            sItem = .PivotItems(i)
            Cells.Copy
            Workbooks.Add
            With ActiveWorkbook
                .Sheets(1).Cells(1).PasteSpecial _
                    Paste:=xlPasteValuesAndNumberFormats
                .SaveAs "C:\TEST\MyReport-" & sItem & ".xlsx", _
                    FileFormat:=xlOpenXMLWorkbook
                .Close
            End With
        Next i
    End With
End With

End Sub However, I know I need to cut out

Cells.Copy
        Workbooks.Add
        With ActiveWorkbook
            .Sheets(1).Cells(1).PasteSpecial _
                Paste:=xlPasteValuesAndNumberFormats
            .SaveAs "C:\TEST\MyReport-" & sItem & ".xlsx", _
                FileFormat:=xlOpenXMLWorkbook
            .Close

I just do not know what to add to for the copying of a certain cell (non-Pivot) and pasting it into a different sheet assuming it meets the >0 criteria. I am relatively new to VBA and I am trying to improve my skills.

Adding Screenshots for Reference Essentially, I am wanting to iterate through B3 (Pivot Table) and copy B3 and F46 into the new sheet pictured below If F46>0. :

Thanks.

Add a screen-shot of your Pivot Table, and an example of which field you want to filter according to your criteria, and what exactly you need to copy (use Paint to describe it bettter) — Shai Rado
is "F46" part of the PivotTable ? or just a cell "riding" on the Pivot Table's value being filterred ? Range("A40:I47") is part of the PivotTable ? Is the cell you want to copy allways in "F46" ? — Shai Rado
F46 is separate from the pivot table. There are other data fields that are "riding" the pivot table data, however those fields are not needing to be copied. The end goal is to have 4 different VBA code sets that feed into 4 separate sheets based on what Quarter is being reviewed. F46=Q1, G46=Q2, ETC. I should be able to edit the VBA to reflect these differences, I just need help building the base code. Once again thanks for the help. — Dustin Duckworth
How about using the PivotTable.GetPivotData Method instead? That way you don't need to do any manipulation of the pivot table, just iterate through the filter values, plug them into the function, test the value returned to make sure is >0, then enter the value on your other sheet. To get an idea of how the function works, go to a cell not in the pivot table, press = then click a cell in the pivot table values section and press Enter. You’ll see that Excel enters the GETPIVOTDATA worksheet function in that cell. — Rachel Hettinger

takanuva15 takanuva15 · Accepted Answer · 2017-07-12T21:44:20

This should work for you. You will need to adjust the pivot and data sheet names as marked below.

Sub PivotStockItems()
    Dim i As Integer
    Dim sItem As String
    Dim pivotSht As Worksheet, dataSht As Worksheet

    Set pivotSht = Sheets("test") 'adjust to the name of sheet containing your pivot table
    Set dataSht = Sheets("SKUS_With_Savings") 'as per your image

    Application.ScreenUpdating = False
    With pivotSht.PivotTables("PivotTable1")
        .PivotCache.MissingItemsLimit = xlMissingItemsNone
        .PivotCache.Refresh
        With .PivotFields("Yes")
            '---hide all items except item 1
            .PivotItems(1).Visible = True
            For i = 2 To .PivotItems.Count
                .PivotItems(i).Visible = False
            Next
            For i = 1 To .PivotItems.Count
                .PivotItems(i).Visible = True
                If i <> 1 Then .PivotItems(i - 1).Visible = False
                sItem = .PivotItems(i)

                'this takes care of the condition and copy-pasting
                If pivotSht.Range("F46").Value > 0 Then
                    dataSht.Cells(getLastFilledRow(dataSht) + 1, 1).Value = sItem
                    dataSht.Cells(getLastFilledRow(dataSht), 2).Value = pivotSht.Range("F46").Value
                Else: End If

            Next i
        End With
    End With
End Sub

'gets last filled row number of the given worksheet
Public Function getLastFilledRow(sh As Worksheet) As Integer
    On Error Resume Next
    getLastFilledRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            LookAt:=xlPart, _
                            LookIn:=xlValues, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function

USE Vba to Iterate through Pivot Table while copying single field into separate sheet

1 Answers