Вставить значения и исходное форматирование не работает

Question

Я пытаюсь скопировать данные из сводной таблицы на новый лист как общие данные в 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

Answer 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

Answer 2

Форматирование сводной таблицы

• Скопируйте код в стандартный модуль (например, Module1).
• Отрегулируйте const муравьев, включая рабочая тетрадь .
• Боюсь, это самое близкое, что я мог найти. Все другие решения, которые я пробовал, включая упомянутое вами, дают вам копию сводной таблицы, а не «свободный» диапазон.

Интересные ссылки

• TableRange1
• TableRange2
• TableStyle2

Код

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