工作表之间复制数据

我在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

每数据透视表在高度（和宽度）上可以是动态的，所以后续表的偏移量将取决于前一个表的大小......

有没有人有任何想法如何实现这一点？

来源

2012-07-16 user559142

查找使用此代码的最后一行http://stackoverflow.com/questions/11169445/error-finding-last-used-cell-in-vba然后粘贴下一个枢轴后。 – 2012-07-16 20:44:16

如何修改上述代码以在特定点粘贴？ – user559142 2012-07-16 20:56:10

过去第1行的第1个表格，然后找到最后一行。加2。将下一个表格粘贴到该行中。再次找到最后一行。加2。将下一个表格粘贴到该行中。重复过程，直到粘贴所有表格。 – 2012-07-16 20:59:32

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

来源

2012-07-16 21:03:17

工作表之间复制数据

回答

相关问题