VBA复制和粘贴数据透视表值和格式 [英] VBA copy and paste pivot values and format

问题描述

我尝试复制并粘贴数据透视表，但是我想保留值和格式.

I try to copy and paste a pivot table, but I want to keep values and format.

Sub PivotTablePaste()

    Set pt = Worksheets("Sheet1").PivotTables(1)
    pt.TableRange2.Copy

    With Worksheets("Sheet1").Range("P1")

        .PasteSpecial Paste:=xlPasteValues

        .PasteSpecial Paste:=xlPasteFormats

        .PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False

    End With

End Sub

推荐答案

显然，此方法仅对>
有效. (这是不带过滤器(即上方的PageFields)的数据透视表的主要范围)
和不和完整的PivotTable.TableRange2.

Apparently this works only with PivotTable.TableRange1
(which is the main range of the pivottable without the filters i. e. the PageFields above it)
and not with the full PivotTable.TableRange2.

如果数据透视表也具有页面字段，则必须逐个单元地复制该数据透视表上方的范围.

If your pivottable has pagefields also, then you have to copy that range above the pivottable additionally cell-by-cell.

Sub PivotTablePaste()
    Dim SourcePivottable As PivotTable
    Dim DestinationRange As Range
    Dim aCell As Range

    Set SourcePivottable = Worksheets("Sheet1").PivotTables(1)
    Set DestinationRange = Worksheets("Sheet1").Range("P1")

    ' Copy TableRange1
    SourcePivottable.TableRange1.Copy
    With DestinationRange.Offset( _
      SourcePivottable.TableRange1.Row - SourcePivottable.TableRange2.Row, 0)
        .PasteSpecial Paste:=xlPasteValues
        .PasteSpecial Paste:=xlPasteFormats
        .PasteSpecial Paste:=xlPasteColumnWidths
    End With

    ' Copy everything above TableRange1 cell-by-cell
    For Each aCell In SourcePivottable.TableRange2.Cells
        If Not Intersect(aCell, SourcePivottable.TableRange1) Is Nothing Then Exit For
        aCell.Copy
        With DestinationRange.Offset( _
          aCell.Row - SourcePivottable.TableRange2.Row, _
          aCell.Column - SourcePivottable.TableRange2.Column)
            .PasteSpecial Paste:=xlPasteValues
            .PasteSpecial Paste:=xlPasteFormats
        End With
    Next aCell

End Sub

这篇关于VBA复制和粘贴数据透视表值和格式的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！