Copy/Paste not working when just one row of data filtered

Question

I have a pivot table that I filter by "location". I then need to copy/paste from that filtered pivot table to a sheet that is named the same name as the current "location" filtered. This works perfectly fine so long as there ends up being more than one row of data. However, when there is only one row of data filtered, the code will copy (seemingly) but when moving to the appropriate location sheet it pastes no data.

Any help would be greatly appreciated.

This is what I have for code:

' create the pickup sheets for the deliveries to each location
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Set pt = ActiveSheet.PivotTables.Item(1)
For Each pf In pt.PageFields
For Each pi In pf.PivotItems
pt.PivotFields(pf.Name).CurrentPage = pi.Name

    Range("A5", Range("A5").End(xlDown).End(xlToRight)).Select 'range A5 so headers not included
    Selection.Copy
    Sheets(pi.Name).Visible = True
    Sheets(pi.Name).Select
    Range("A" & Rows.Count).End(xlUp).Offset(2).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Pickup Lists").Select
    Sheets(pi.Name).Visible = False

Instead of try to copy the pivot table, why don't try to create pivot table using VBA? — Kin Siang, May 28 '21 at 14:07
I'm copying just the lines of data from the filtered pivot table. The main data changes constantly, so I need to copy to keep a running list of items per delivery location. — mandeanda, May 28 '21 at 14:56

score 0 · Answer 1 · answered May 28 '21 at 15:10

I can copy the data without using any pivot object, since it doesn't involve to create new pivot table therefore by reference to the range value and copy the data should be faster, here is my solution, feel free to addon in case you are facing issue:

Original data (F3 is the outcome):

This the VBA code i am executing:

Sub pivot()

Dim pLastRow As Long, lastCol As Long

pLastRow = Sheet2.Range("A4").End(xlDown).Row - 1
lastCol = Sheet2.Range("A4").End(xlToRight)

Sheet2.Range(Cells(4, 1), Cells(pLastRow, lastCol)).Copy Sheet2.Range("F4")

End Sub

Copy/Paste not working when just one row of data filtered

1 Answers1