使用Vba通过数据透视表迭代单个字段到单独的工作表

我正在使用Excel 2013，我有一个数据透视表，其中有数百个filter值，我需要迭代，使每个单独可见，然后复制过滤的值，以及特定的单元格（非透视，IF> 0）和将其粘贴（仅限值）到指定的表格中，然后转到下一个透视项目并执行相同的操作。 我发现了一些类似于我想要的代码

Sub PivotStockItems() Dim i As Integer Dim sItem As String Application.ScreenUpdating = False With ActiveSheet.PivotTables("PivotTable1") .PivotCache.MissingItemsLimit = xlMissingItemsNone .PivotCache.Refresh With .PivotFields("Country") '---hide all items except item 1 .PivotItems(1).Visible = True For i = 2 To .PivotItems.Count .PivotItems(i).Visible = False Next For i = 1 To .PivotItems.Count .PivotItems(i).Visible = True If i <> 1 Then .PivotItems(i - 1).Visible = False sItem = .PivotItems(i) Cells.Copy Workbooks.Add With ActiveWorkbook .Sheets(1).Cells(1).PasteSpecial _ Paste:=xlPasteValuesAndNumberFormats .SaveAs "C:\TEST\MyReport-" & sItem & ".xlsx", _ FileFormat:=xlOpenXMLWorkbook .Close End With Next i End With End With 

End Sub然而，我知道我需要切断

 Cells.Copy Workbooks.Add With ActiveWorkbook .Sheets(1).Cells(1).PasteSpecial _ Paste:=xlPasteValuesAndNumberFormats .SaveAs "C:\TEST\MyReport-" & sItem & ".xlsx", _ FileFormat:=xlOpenXMLWorkbook .Close 

我只是不知道为了复制某个单元格（非透视图）而添加了什么内容，并将其粘贴到另一个表中，前提是它满足> 0条件。 我对VBA比较陌生，我正在努力提高自己的技能。

添加截图参考从本质上讲，我想通过B3（透视表）迭代，并复制B3和F46到新图表如下F46> 0。 ：

谢谢。

Answer 1

这应该适合你。 您将需要调整数据透视表和数据表名称，如下所示。

 Sub PivotStockItems() Dim i As Integer Dim sItem As String Dim pivotSht As Worksheet, dataSht As Worksheet Set pivotSht = Sheets("test") 'adjust to the name of sheet containing your pivot table Set dataSht = Sheets("SKUS_With_Savings") 'as per your image Application.ScreenUpdating = False With pivotSht.PivotTables("PivotTable1") .PivotCache.MissingItemsLimit = xlMissingItemsNone .PivotCache.Refresh With .PivotFields("Yes") '---hide all items except item 1 .PivotItems(1).Visible = True For i = 2 To .PivotItems.Count .PivotItems(i).Visible = False Next For i = 1 To .PivotItems.Count .PivotItems(i).Visible = True If i <> 1 Then .PivotItems(i - 1).Visible = False sItem = .PivotItems(i) 'this takes care of the condition and copy-pasting If pivotSht.Range("F46").Value > 0 Then dataSht.Cells(getLastFilledRow(dataSht) + 1, 1).Value = sItem dataSht.Cells(getLastFilledRow(dataSht), 2).Value = pivotSht.Range("F46").Value Else: End If Next i End With End With End Sub 'gets last filled row number of the given worksheet Public Function getLastFilledRow(sh As Worksheet) As Integer On Error Resume Next getLastFilledRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ LookAt:=xlPart, _ LookIn:=xlValues, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function