粘贴值和源格式不起作用答案

【问题标题】：Paste Values & Source formatting doesn't work粘贴值和源格式不起作用
【发布时间】：2020-06-20 18:52:34
【问题描述】：

我正在尝试将数据从数据透视表复制到新工作表作为 vba 中的公共数据。我想保留数据透视表的格式（子项的制表符分隔符、组的粗体等）。当我手动复制数据透视表并使用“值和源格式”按钮将其粘贴时，它工作正常。当我记录上述功能的宏时，我得到以下代码：

Sub Macro()
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

但是当我在我的代码中使用这个宏时（选择被一个范围替换）然后数据被复制但没有格式。

这是我的代码：

Set sh = WB1.Sheets("RESULT")
WB1.Sheets("PIVOT").Range("A1:D" & lRow).Copy
sh.Range("A1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
    , SkipBlanks:=False, Transpose:=False
sh.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

【问题讨论】：

标签： excel vba

【解决方案1】：

试试这个

sh.Range("A1").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False
sh.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False

【讨论】：

【解决方案2】：

数据透视表格式

将代码复制到标准模块中（例如Module1）。
调整constant，包括workbook。
恐怕这是我能得到的最接近的。我尝试过的所有其他解决方案，包括您提到的解决方案，都会为您提供数据透视表的副本，而不是“免费”范围。

有趣的链接

守则

Option Explicit

Sub pastePivotTable()
    
    ' Source
    Const srcName As String = "PIVOT"
    Const pivName As String = "PivotTable1"
    ' Target
    Const tgtName As String = "RESULT"
    Const tgtFirst As String = "A1"
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim piv As PivotTable: Set piv = wb.Worksheets(srcName).PivotTables(pivName)
    Dim rng As Range: Set rng = wb.Worksheets(tgtName).Range(tgtFirst)
    piv.TableRange1.Copy
    rng.PasteSpecial xlPasteFormats
    rng.PasteSpecial xlPasteValues
   
End Sub

【讨论】：