从数据透视表vba提取数据

我有一个数据透视表来聚合"part" "coverage" "part"只为接受的部分。

然后，我想要将"sum of coverage"提取到另一个工作表。 我写了下面这个macros：

 Sub Pull_data() 'Update the pivot table Sheets("Pivot").PivotTables("PivotTable2").PivotCache.Refresh 'clear all filters Sheets("Pivot").PivotTables("PivotTable2").PivotFields("Accepted").ClearAllFilters 'filters only accepted items Sheets("Pivot").PivotTables("PivotTable2").PivotFields("Accepted").CurrentPage = "YES" 'get the last row of the pivot table Set PT = Sheets("Pivot").PivotTables("PivotTable2") With PT.TableRange1 lngLastRow = .rows(.rows.Count).Row End With For i = 4 To lngLastRow 'copy the coverage to destination sheet NEWi = i + 10 Sheets("Destination").Range("G" & NEWi) = PivotTable.GetPivotData(data_field, Range("I" & i), “Coverage”) Next i End Sub 

我得到一个运行时错误'424'，需要的对象

 Sheets("Destination").Range("G" & NEWi) = PivotTable.GetPivotData(data_field, Range("I" & i), “Coverage”) 

这将是写这条线的正确方法？

Answer 1

这应该是：

 Sheets("Destination").Range("G" & i + 10).Value = _ pT.GetPivotData("Sum of coverage", "Part", Range("I" & i).Value).Value 

因为pT.GetPivotData返回一个Range！

清理过的代码：

 Sub Pull_data() Dim pT As PivotTable Set pT = Sheets("Pivot").PivotTables("PivotTable2") With pT '''Update the pivot table .PivotCache.Refresh '''clear all filters .PivotFields("Accepted").ClearAllFilters '''filters only accepted items .PivotFields("Accepted").CurrentPage = "YES" '''get the last row of the pivot table With .TableRange1 lngLastRow = .Rows(.Rows.Count).Row For i = .Cells(2, 1).Row To lngLastRow Debug.Print "i=" & i & "|" & Sheets("Pivot").Range("I" & i).Value '''copy the coverage to destination sheet Sheets("Destination").Range("G" & i + 10).Value = _ pT.GetPivotData("Sum of coverage", "Part", Sheets("Pivot").Range("I" & i).Value).Value Next i End With '.TableRange1 End With 'pT End Sub 

Answer 2

根据您的需要，您可以尝试从PivotTable复制整个列，使用TableRange2 ，将Resize到单个列，然后Copy并PasteSpecial xlValues到目标工作表。

如果下面的代码带有错误的列，您也可以使用Offset(0,1)来获取正确的值。

 With PT .TableRange2.Resize(.TableRange2.Rows.Count, 1).Copy Worksheets("Destination").Range("G14").PasteSpecial xlValues '<-- start Pasting from Row 14 End With 

注意 ：如果上面的代码将列放在左边，请尝试下面的代码行：

 .TableRange2.Resize(.TableRange2.Rows.Count, 1).Offset(, 1).Copy