VBA将数据透视数据复制到列中的下一个空白单元格

Question

已经创建了一个数据透视表，我需要一个宏，它可以从指定的工作表 (Pivot1) 中提取没有过滤器的数据透视主体数据，并将结果复制到下一个空白单元格上的另一个工作表 (Selection) 中。

我已经使用并修改了以下内容，我在这个网站上找到了它，但是它没有拿起我的床单，我得到一个运行时错误“424” 有关如何执行此操作的任何想法？

Sub PastePivot()

Dim i As Long
Dim LR As Long
Dim j As Long
Dim c As Long
'Find last used row in Pivot1
LR = Pivot1.Cells(Pivot1.Rows.Count, 1).End(xlUp).Row
'Find last used row in Selection
j = Selection.Cells(Selection.Rows.Count, 1).End(xlUp).Row
'Loop through rows on Pivot1
For i = 3 To LR
    'Decide whether to copy the row or not
    If Pivot1.Cells(i, 1).Value <> "0" Then
        'Update pointer to the next unused row in Selection
        j = j + 1
        'Only copy used columns, to stop it thinking every cell in the
        'destination row is "used"
        c = Pivot1.Cells(i, Pivot1.Columns.Count).End(xlToLeft).Column
        'Copy the values (without using Copy/Paste via the clipboard)
        Selection.Rows(j).Resize(1, c).Value = Pivot1.Rows(i).Resize(1, c).Value
    End If
Next i

结束子

Answer 1

如果您想获取数据透视表的主体，请使用它的 DataBodyRange 属性。

以下代码假设您在“Sheet1”上有 1 个数据透视表，并且您希望将其复制到“Sheet2”。

Sub CopyPivotBody()
Dim ws As Worksheet
Dim pt As PivotTable
Dim rngBody As Range

    Set ws = Sheets("Sheet1")
    Set pt = ws.PivotTables(1)
    Set rngBody = pt.DataBodyRange
    
    rngBody.Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
    
End Sub

请注意，如果这不能为您提供所需的确切范围，您可以像任何其他范围一样对其进行偏移/调整大小。