copy paste pivot table values and formatting

[pliskers]

Is someone familiar with the use of the TableRange2 command? I understand it can be used to copy and paste a pivot table's values and formatting onto itself. Normal commands work on values, but not formats.

Thank you!

 

[AKTools]

Hi,

you have to copy and paste the pivot table twice. First the values and then the Formats. If your Pivot table is in Cell A1 you can use this code. Otherwise please amend the code to your needs.

Sub CopyPivotValuesAndFormats()
    With [A1]
        '***Values
        .PivotTable.TableRange2.Copy
        .Offset(0, 10).PasteSpecial xlPasteValues
        '***Formats
        .PivotTable.TableRange2.Copy
        .Offset(0, 10).PasteSpecial xlPasteFormats
    End With
End Sub

 

[pliskers]

A slight issue is that I'm copying/pasting the pivot table onto itself, so once we copy/paste the values, the formats disappear.

The pivot table to be copy/pasted will have been copied from another sheet, named Pivot.

Could you possibly suggest some coding that would copy the formatting from the original (on the Pivot sheet) and then return to the current sheet to paste the formatting?

Thanks again!

 

[pliskers]

Sorry, but I just checked and the code is not pasting formats, only values. I am using Excel 2007 - does that impact anything? Is there a setting that needs to be applied, or some other change to the code?

 

[AKTools]

This code should solve your problem.

Sub CopyPivotValuesAndFormats()
    Dim WKS As Worksheet
    Dim PT As PivotTable
    Set PT = ActiveSheet.Range("A1").PivotTable
    Dim PT_TopLeftCell As Range
    Set PT_TopLeftCell = PT.TableRange2.Cells(1, 1)

    '***Insert new temporary sheet
    Set WKS = ThisWorkbook.Worksheets.Add
    
    '***Copy Pivot table
    PT.TableRange2.Copy
    
    '***Insert Values
    WKS.Range("A1").PasteSpecial xlPasteValues
    
    '***Copy Pivot table
    PT.TableRange2.Copy
    
    '***Insert Formats
    WKS.Range("A1").PasteSpecial xlPasteFormats
    
    '***Copy temp. copy of Pivot table and paste to original Pivot table location
    WKS.Range("A1").CurrentRegion.Copy PT_TopLeftCell
    
    '***Delete temporary Worksheet
    Application.DisplayAlerts = False
    WKS.Delete
    Application.DisplayAlerts = True
    
    Set PT_TopLeftCell = Nothing
    Set PT = Nothing
    Set WKS = Nothing
End Sub

 

[pliskers]

Thanks for trying, but it doesn't work. It runs to the line:

WKS.Range("A1").CurrentRegion.Copy PT_TopLeftCell

And then delivers a run time error 1004.

I've done a ton of researching on this, and it appears that any copy/paste formats done against a pivot table in Excel 2007 doesn't work with VBA code, at least none that I can find. I've gotten around the issue by using an autoformat on the pasted values.

Thanks for trying.

 

[AKTools]

This code should solve your problem.

Sub CopyPivotValuesAndFormats()
    Dim WKS As Worksheet
    Dim PT As PivotTable
    Set PT = [COLOR=Red]ActiveCell[/COLOR].PivotTable
    Dim PT_TopLeftCell As Range
    Set PT_TopLeftCell = PT.TableRange2.Cells(1, 1)

    '***Insert new temporary sheet
    Set WKS = ThisWorkbook.Worksheets.Add
    
    '***Copy Pivot table
    PT.TableRange2.Copy
    
    '***Insert Values
    WKS.Range("A1").PasteSpecial xlPasteValues
    
    '***Copy Pivot table
    PT.TableRange2.Copy
    
    '***Insert Formats
    WKS.Range("A1").PasteSpecial xlPasteFormats
    
    '***Copy temp. copy of Pivot table and paste to original Pivot table location
    WKS.Range("A1").CurrentRegion.Copy PT_TopLeftCell
    
    '***Delete temporary Worksheet
    Application.DisplayAlerts = False
    WKS.Delete
    Application.DisplayAlerts = True
    
    Set PT_TopLeftCell = Nothing
    Set PT = Nothing
    Set WKS = Nothing
End Sub

See above (red)
Change the script as shown, select a cell within the pivottable and run the macro.
I assumed you have your pivot in Cell A1.