Copy Paste Pivot Tables

[uk747]

Hi

Have 2 pivot tables which are identical, only difference is in pt_2 I have removed the Filter

What I find is that in F5 the Pivot Table copied is how the Pivot Table appears and doesn't appear as a pivot table which is what I want(Like a normal table)
However in K5 the Pivot Table appears as a pivot table with all the details of a pivot table
I've Tried .TableRange2.Copy Range("K5") but still get the same result

I know I could copy the Pivot and Paste as Values and then as Formats but was wondering if it's possible using the pivot table range

ActiveSheet.PivotTables("pt_1").TableRange1.Copy Range("F5")
ActiveSheet.PivotTables("pt_2").TableRange1.Copy Range("K5")

 

[Alex Blakenburg]

Do you mean you that you removed the page filter ?
The issue with copying pivot tables as values with formatting is that you can't copy the whole pivot table in one go.
TableRange1 picks up the range of the entire pivot table but without the page fields. If you have page fields then this will copy as values since you are not copying the entire table.
For the pivot with no page fields this does equate to copying the entire table and as such it copies as a real pivot table and not just values.

If you want to just get some code that works then you can use Debra Dalgleish's code here:

Excel Pivot Table Macro Paste Format Values

Use Excel VBA to copy a pivot table, and paste its values and format onto a new worksheet

www.contextures.com

 

[uk747]

Yes Page Filter was removed.

pt_1 had a page Filter. I copied pt_1 and renamed pt_2 and wasn't sure how when I copied it that the 1st one pasted as I wanted with just formats and Values, but the 2nd on was if I had copied and Pasted ALL of it, i.e had all the functionality of a Pivot table which i didnt want

 

[Alex Blakenburg]

You didn't say whether the code on the contextures link does what you need.
It sounds like you don't want the page filters to be copied across, in that case you could try something like this.

Sub CopyPastePivotValuev02()

    Dim ptName As String
    Dim ptRng2Full As Range, ptRng1Body As Range
    Dim ptRowsFull As Long, ptRowsBody As Long
    Dim destRng As Range
   
    ptName = "pt_2"                     ' <--- Change as required
    With ActiveSheet.PivotTables(ptName)
        Set ptRng2Full = .TableRange2
        Set ptRng1Body = .TableRange1
        ptRowsFull = ptRng2Full.Rows.Count
        ptRowsBody = ptRng1Body.Rows.Count
        Set destRng = Range("K5")      ' <--- Change as required
       
        If ptRowsBody = ptRowsFull Then
            ' Pivot has no page filters copy in parts
            ptRng1Body.Offset(1).Resize(ptRowsBody - 1).Copy Destination:=destRng.Offset(1)

            ptRng1Body.Rows(1).Copy Destination:=destRng
        Else
            ' Pivot has page filters copy body then page filters
            ptRng1Body.Copy Destination:=destRng
           
'           Uncomment if you want the page filter headings
'            ptRng2Full.Resize(ptRowsFull - ptRowsBody).Copy
'            ptRng2Full.Cells(1).CurrentRegion.Copy _
'                Destination:=destRng.Offset(-(ptRowsFull - ptRowsBody))
        End If
       
    End With
End Sub

 

[uk747]

Sorry Alex, Only just seen your reply
Contextures link looked too complicated for what I needed

I didn't want the Filters and eventually just went with Copying and pasting Values and then Formats

 

[Alex Blakenburg]

That typically won't bring over the colours on the headings and totals.
Did you try my code in Post # 4

 

[uk747]

That typically won't bring over the colours on the headings and totals.
Did you try my code in Post # 4

Hi

Just tried and copied your code above and it pasted as needed but did the same as copy pasting values and then copy pasting formats.

Maybe yours will copy more advanced pivot tables that the Values/Formats won't

 

[Alex Blakenburg]

It sounds like you have what you need. Let me know if you don't.