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

centsational

New Member
Joined
May 28, 2021
Messages
8
Office Version
  1. 365
Platform
  1. Windows
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:

VBA 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
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
13,908
Office Version
  1. 365
Platform
  1. Windows
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 **
VBA Code:
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 :oops: ).
 

centsational

New Member
Joined
May 28, 2021
Messages
8
Office Version
  1. 365
Platform
  1. Windows
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 **
VBA Code:
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 :oops: ).
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

New Member
Joined
May 28, 2021
Messages
8
Office Version
  1. 365
Platform
  1. Windows
Sorry, I didn't finish before hitting the post button.
I get the error "this action won't work on multiple selections"
 

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
13,908
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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.
VBA Code:
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

New Member
Joined
May 28, 2021
Messages
8
Office Version
  1. 365
Platform
  1. Windows
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

Well-known Member
Joined
Dec 30, 2008
Messages
13,908
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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.
VBA Code:
Range(.DataBodyRange, .DataBodyRange.Offset(, -1)).Copy
 

centsational

New Member
Joined
May 28, 2021
Messages
8
Office Version
  1. 365
Platform
  1. Windows
That one causes it to copy columns C and D, instead of A-D. :)

Screenshot 2021-05-31 102549.jpg
 

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
13,908
Office Version
  1. 365
Platform
  1. Windows
Not sure what you've got going on there but the suggestion should work with any normal pivot table.

See what this does.
VBA Code:
Range("A5", .DataBodyRange).Copy
 
Solution

centsational

New Member
Joined
May 28, 2021
Messages
8
Office Version
  1. 365
Platform
  1. Windows
DataBodyRange.Offset(,-3).Copy seems to do the trick though.
Thanks so much for your help.
 

Forum statistics

Threads
1,144,366
Messages
5,723,942
Members
422,527
Latest member
TotalBeginner201

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top