user6632933
user6632933

Reputation:

Copying PivotTable Values in VBA

I have created a pivot table via macro and want to copy the pivot table as values using VBA. Creating a Pivot Table went well but copying it to another sheet gives me a headache. Here's the code:

Sub test()
Dim shtTarget, pvtSht As Worksheet
Dim pc As PivotCache
Dim pt As PivotTable
Dim field As PivotField
Dim rngSource As Range

With ActiveWorkbook
    Set rngSource = .Sheets(2).Range("H:I").CurrentRegion
    Set shtTarget = .Sheets.Add(After:=.Sheets(.Sheets.count))
    shtTarget.Name = "Temp"
    Set pc = .PivotCaches.Create(xlDatabase, rngSource, xlPivotTableVersion14)
    Set pt = pc.CreatePivotTable(shtTarget.Range("A1"), "PivotTable1", , xlPivotTableVersion14)

End With

With shtTarget.PivotTables("PivotTable1").PivotFields("Concatenate")
    .Orientation = xlRowField
    .Position = 1
End With

With shtTarget
    .PivotTables("PivotTable1").AddDataField .PivotTables( _
    "PivotTable1").PivotFields("SCREEN_ENTRY_VALUE"), "Count of SCREEN_ENTRY_VALUE" _
    , xlSum
End With

With ActiveWorkbook
    Set pvtSht = .Sheets.Add(After:=.Sheets(.Sheets.count))
    pvtSht.Name = "Sum of Element Entries"

'==========================I'm stuck on this line=================================

    .Sheets(shtTarget).PivotTables("PivotTable1").TableRange1.Copy 
    pvtSht.Range("A1").PasteSpecial xlPasteValues
End With

End Sub

The error is a Type mismatch error.

Upvotes: 3

Views: 26800

Answers (1)

Shai Rado
Shai Rado

Reputation: 33682

Try the code below, it's a little "cleaner" , the modifications I made:

  • 1) To copy the Pivot Table's data and paste in another Worksheet as values, you need to use TableRange2 and not TableRange1.
  • 2) You already defined and set your pt object so nicely to your PivotTable, why not continue to use it ? Everywhere in your code you have shtTarget.PivotTables("PivotTable1") can be replaced with a short pt.

Code (tested)

Option Explicit

Sub test()

Dim shtTarget As Worksheet, pvtSht As Worksheet
Dim pc As PivotCache
Dim pt As PivotTable
Dim field As PivotField
Dim rngSource As Range

With ActiveWorkbook
    Set rngSource = .Sheets(2).Range("H:I").CurrentRegion
    Set shtTarget = .Sheets.Add(After:=.Sheets(.Sheets.Count))
    shtTarget.Name = "Temp"

    Set pc = .PivotCaches.Create(xlDatabase, rngSource, xlPivotTableVersion14)
    Set pt = pc.CreatePivotTable(shtTarget.Range("A1"), "PivotTable1", , xlPivotTableVersion14)
End With

With pt.PivotFields("Concatenate")
    .Orientation = xlRowField
    .Position = 1
End With

pt.AddDataField pt.PivotFields("SCREEN_ENTRY_VALUE"), "Sum of SCREEN_ENTRY_VALUE", xlSum

With ActiveWorkbook
    Set pvtSht = .Sheets.Add(After:=.Sheets(.Sheets.Count))
    pvtSht.Name = "Sum of Element Entries"

    pt.TableRange2.Copy
    pvtSht.Range("A1").PasteSpecial xlPasteValues
End With

End Sub

Upvotes: 5

Related Questions