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

[centsational]

I have a pivot table, created from an always changing spreadsheet of orders, that I filter by "location". I have code that loops through the filter field to copy the filtered data into 15 other sheets, each sheet named as the current "location" filtered, creating Delivery Order sheets for each location delivery. 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, I'm a somewhat beginner and have been teaching myself just this year.

This is what I have for code:

' create the order 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

 

[jasonb75]

Without testing I'm not exactly sure what is happening, typically when you use xlDown with no data below the starting cell it selects all of the empty rows down to the bottom of the sheet (or to the next non empty row if you have empty rows, then more data further down the sheet).

I don't have a suitably structured workbook to test on, but this would be my starting point for the task (thrown together from bits of your code and what I found in in the help file).

** I would recommend creating at least one extra copy of your workbook for testing purposes in order to preserve your original data if it all goes wrong **

Dim pf As PivotField, pi As PivotItem

With Sheets("Pickup Lists").PivotTables.Item(1)

    For Each pf In .PageFields
        For Each pi In pf.PivotItems
            .PivotFields(pf.Name).CurrentPage = pi.Name
            Application.Union(.DataBodyRange, .RowRange).Copy
            Sheets(pi.Name).Range("A" & Rows.Count).End(xlUp).Offset(2).PasteSpecial (xlValues)
            Application.CutCopyMode = False
        Next
    Next

End With

I've done it without selecting, which will be much quicker and works without making the hidden sheets visible first (as long as it doesn't error out on something else that I got wrong ).

 

[centsational]

Without testing I'm not exactly sure what is happening, typically when you use xlDown with no data below the starting cell it selects all of the empty rows down to the bottom of the sheet (or to the next non empty row if you have empty rows, then more data further down the sheet).

I don't have a suitably structured workbook to test on, but this would be my starting point for the task (thrown together from bits of your code and what I found in in the help file).

** I would recommend creating at least one extra copy of your workbook for testing purposes in order to preserve your original data if it all goes wrong **

Dim pf As PivotField, pi As PivotItem

With Sheets("Pickup Lists").PivotTables.Item(1)

    For Each pf In .PageFields
        For Each pi In pf.PivotItems
            .PivotFields(pf.Name).CurrentPage = pi.Name
            Application.Union(.DataBodyRange, .RowRange).Copy
            Sheets(pi.Name).Range("A" & Rows.Count).End(xlUp).Offset(2).PasteSpecial (xlValues)
            Application.CutCopyMode = False
        Next
    Next

End With

I've done it without selecting, which will be much quicker and works without making the hidden sheets visible first (as long as it doesn't error out on something else that I got wrong ).

Hi! Thanks for your reply.
Unfortunately, using the code you've provided, this doesn't copy any of the data over into the allocated sheets for me.

 

[centsational]

Sorry, I didn't finish before hitting the post button.
I get the error "this action won't work on multiple selections"

 

[jasonb75]

Possibly it doesn't like the union method, see if this one behaves differently. If it errors again, please debug and say which line the error occurs on.

Dim pf As PivotField, pi As PivotItem

With Sheets("Pickup Lists").PivotTables.Item(1)

    For Each pf In .PageFields
        For Each pi In pf.PivotItems
            .PivotFields(pf.Name).CurrentPage = pi.Name
            Range(.RowRange,.DataBodyRange).Copy
            Sheets(pi.Name).Range("A" & Rows.Count).End(xlUp).Offset(2).PasteSpecial (xlValues)
            Application.CutCopyMode = False
        Next
    Next

End With

 

[centsational]

That works with no errors, thank you.
Is there a line that I can add into that code that will tell it to not also copy the Headers? I'll have 400 lines of headers by the time I go to print the sheet for deliveries

 

[jasonb75]

Oops, I missed that the .RowRange part includes the 'Row Labels' cell with the filter dropdown at the top. That explains why the union method failed.

Try changing the copy line as below.

Range(.DataBodyRange, .DataBodyRange.Offset(, -1)).Copy

 

[centsational]

That one causes it to copy columns C and D, instead of A-D.

 

[jasonb75]

Not sure what you've got going on there but the suggestion should work with any normal pivot table.

See what this does.

Range("A5", .DataBodyRange).Copy

 

[centsational]

DataBodyRange.Offset(,-3).Copy seems to do the trick though.
Thanks so much for your help.