我无法将数据透视表格式粘贴到另一个页面

Question

尝试将 Excel 上的数据透视表从一页复制并粘贴到另一页。 代码有效，但不会粘贴格式。

Sub TestPivotPaste()
Dim wb As Workbook
Dim sh As Worksheet
Dim sh1 As Worksheet
Dim copyrange As Range

Set wb = ActiveWorkbook
Set sh = wb.Worksheets(8)
Set copyrange = sh.Range("A1:Z50")
Set sh1 = wb.Worksheets(9)


copyrange.Copy
sh1.Range("B50").PasteSpecial Paste:=xlPasteValues
sh1.Range("B50").PasteSpecial Paste:=xlPasteFormats
sh1.Range("B50").PasteSpecial Paste:=xlPasteColumnWidths

End Sub

我试着在同一个页面上做

Sub TestPivotPaste()
Dim wb As Workbook
Dim sh As Worksheet
Dim copyrange As Range
Set wb = ActiveWorkbook
Set sh = wb.Worksheets(8)
Set copyrange = sh.Range("A1:Z50")
copyrange.Copy
sh.Range("B50").PasteSpecial Paste:=xlPasteValues
sh.Range("B50").PasteSpecial Paste:=xlPasteFormats
sh.Range("B50").PasteSpecial Paste:=xlPasteColumnWidths
End Sub

它仍然会在没有格式的情况下被复制，我得到了 运行时错误 1004：Range 类的 PasteSpecial 方法失败，罪名是

sh.Range("B50").PasteSpecial Paste:=xlPasteFormats

通过查看此网站上的类似答案，我无法弄清楚问题出在哪里

Answer 1

尝试如下复制整个表格范围（您可能需要更改数据透视表所属的范围）：

Sub TestPivotPaste()

Dim wb As Workbook
Dim sh As Worksheet
Dim sh1 As Worksheet
Dim copyrange As Range

Set wb = ActiveWorkbook
Set sh = wb.Worksheets(8)
Set pt = sh.Range("A3").PivotTable
Set sh1 = wb.Worksheets(9)
Set copyrange = pt.TableRange1

copyrange.Copy
sh1.Range("B50").PasteSpecial Paste:=xlPasteValues
sh1.Range("B50").PasteSpecial Paste:=xlPasteFormats
sh1.Range("B50").PasteSpecial Paste:=xlPasteColumnWidths

End Sub