在 VBA 中复制数据透视表值

Copying PivotTable Values in VBA

提问by Shai Rado

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:

我已经通过宏创建了一个数据透视表，并希望使用 VBA 将数据透视表复制为值。创建数据透视表进展顺利，但将其复制到另一张工作表让我头疼。这是代码：

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 mismatcherror.

错误是Type mismatch错误。

回答by Shai Rado

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 Worksheetas values, you need to use TableRange2and not TableRange1.
• 2)You already defined and set your ptobject 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.

• 1)要复制数据透视表的数据并将其Worksheet作为值粘贴到另一个中，您需要使用TableRange2而不是TableRange1.
• 2）您已经pt很好地定义并设置了您的对象PivotTable，为什么不继续使用它呢？代码中的任何地方都shtTarget.PivotTables("PivotTable1")可以用一个简短的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