在VBA中复制数据透视表值

我已经通过macros创build了一个数据透视表，并希望使用VBA将数据透视表复制为值。 创build一个数据透视表进行得很顺利，但是把它复制到另一个表格让我头疼。 代码如下：

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 

错误是Type mismatch错误。

Answer 1

尝试下面的代码，这是一个“干净”，我做的修改：

• 1）要复制数据透视表的数据并粘贴到另一个Worksheet作为值，您需要使用TableRange2而不是TableRange1 。
• 2）你已经定义和设置你的pt对象很好的PivotTable ，为什么不继续使用它？ 在你的代码中的任何地方你有shtTarget.PivotTables("PivotTable1")可以用一个简短的ptreplace。

代码 （testing）

 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