在工作表之间复制数据

时间:2012-07-16 20:42:52

标签: excel vba excel-vba pivot-table

我在Excel中的不同工作表中有多个数据透视表(每个工作表1个)。我想将它们全部复制到一个新的工作表中,但我希望它们在彼此之下,每个之间有两行间隔。

我有一个代码将一个表从一个工作表复制到另一个工作表,但我无法弄清楚如何将另一个工作表复制到同一个工作表而不将其粘贴到上一个表中....

'Copy table 1
Sheet1.PivotTables(1).TableRange2.Copy
With Sheet7.Range(Sheet1.PivotTables(1).TableRange2.Address)
    .PasteSpecial xlPasteValuesAndNumberFormats
    .PasteSpecial xlPasteColumnWidths
End With
Application.CutCopyMode = False

每个数据透视表的高度(和宽度)都是动态的,因此后续表的偏移量将取决于前一个数据库的大小....

有谁知道如何实现这个?

1 个答案:

答案 0 :(得分:0)

Sub CopyPT()

Dim rngDest As Range
Dim sht As Worksheet, tr As Range

    Set rngDest = Sheet7.Range("B2")

    For Each sht In ThisWorkbook.Worksheets

        If sht.Name <> Sheet7.Name Then
            If sht.PivotTables.Count = 1 Then
                Set tr = sht.PivotTables(1).TableRange2
                'Debug.Print sht.Name, tr.Rows.Count
                tr.Copy
                With rngDest
                    .PasteSpecial xlPasteValuesAndNumberFormats
                    .PasteSpecial xlPasteColumnWidths
                End With
                Set rngDest = rngDest.Offset(tr.Rows.Count + 2, 0)
            End If
        End If

    Next sht

    Application.CutCopyMode = False

End Sub