VBA 如何在新的工作簿中粘贴特殊保留格式

Question

我想复制并粘贴特殊的 (values & format) 从工作簿 A 到工作簿 B 的范围。问题是：值是粘贴的，但不是格式

我已经尝试了所有的 PasteSpecial，但是 none 有效...

Sub Macro_copy_paste_pivot()
    Dim date_report As String
    Dim appExcel As Excel.Application
    Dim XLBook As Workbook

    Set appExcel = CreateObject("Excel.Application")
    Set XLBook = appExcel.Workbooks.Add
    date_report = WorksheetFunction.WorkDay(Date, -1)
    date_report = Format(date_report, "yyyy-mm-dd")

    ' COPY and PASTE the pivot EXO
    Worksheets("Pivot EXO").Activate
    ActiveSheet.PivotTables("Pivot EXO").PivotFields( _
        "[Context].[AsOfDate].[AsOfDate]").VisibleItemsList = Array( _
        "[Context].[AsOfDate].&[" & date_report & "T00:00:00]")

    Range("P7:A24").Copy
    XLBook.Sheets.Add.Name = "EXO"
    XLBook.Worksheets("EXO").Range("P7:A24").PasteSpecial Paste:=xlPasteFormats

End Sub

那么，如何将工作簿 A 的格式粘贴到工作簿 B？

Answer 1

基本上，您复制的数据透视范围内的值根本没有格式化，只是显示它们格式化的数据透视 table 样式。

一个解决方法是复制您的值，然后将您复制的值转换为 table 并应用与您的数据透视表 table 相同的格式（更多详细信息请参阅评论）：

Sub Macro_copy_paste_pivot()
    Dim date_report As String
    Dim appExcel As Excel.Application
    Dim XLBook As Workbook, XLBookSource As Workbook    'Declare your source workbook too

    Set appExcel = CreateObject("Excel.Application")
    Set XLBookSource = ThisWorkbook                     'Set the source workbook.. alternatively use ActiveWorkbook or specific book
    Set XLBook = appExcel.Workbooks.Add
    date_report = WorksheetFunction.WorkDay(Date, -1)
    date_report = Format(date_report, "yyyy-mm-dd")

    ' COPY and PASTE the pivot EXO
    XLBookSource.Worksheets("Pivot EXO").PivotTables("Pivot EXO").PivotFields( _
        "[Context].[AsOfDate].[AsOfDate]").VisibleItemsList = Array( _
        "[Context].[AsOfDate].&[" & date_report & "T00:00:00]")

    Range("P7:A24").Copy
    XLBook.Sheets.Add.Name = "EXO"
    With XLBook.Worksheets("EXO")
        .Range("P7:A24").PasteSpecial Paste:=xlPasteValues
        .ListObjects.Add(xlSrcRange, .Range("P7:A24"), , xlYes).Name = "TableNameWhatever"  'Add a table for this range.. note this adds headers as well, review as needed
        .ListObjects("TableNameWhatever").TableStyle = XLBookSource.Worksheets("Pivot EXO").PivotTables("PivotTable1").TableStyle2  'Give the same style as the pivot table
    End With
End Sub

Answer 2

我解决了我的问题。

问题是我创建了一个新的 Excel.Application。使用下面的代码，我的特殊粘贴工作正常。

但我不明白为什么当您粘贴到另一个 Excel.Application 时 xlPasteFormats 不起作用。 .

Sub Macro_copy_paste_pivot()
    Application.ScreenUpdating = False
    Dim date_report As String
    Dim XLBook As Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook

    Set XLBook = Workbooks.Add
    date_report = WorksheetFunction.WorkDay(Date, -1)
    date_report = Format(date_report, "yyyy-mm-dd")

    ' COPY and PASTE the pivot EXO
    wb.Worksheets("Pivot EXO").PivotTables("Pivot EXO").PivotFields( _
        "[Context].[AsOfDate].[AsOfDate]").VisibleItemsList = Array( _
        "[Context].[AsOfDate].&[" & date_report & "T00:00:00]")
    wb.Worksheets("Pivot EXO").Range(wb.Worksheets("Pivot EXO").Range("P7"), wb.Worksheets("Pivot EXO").Cells(Rows.count, 1).End(xlUp)).Copy
    XLBook.Sheets.Add.Name = "EXO"
    XLBook.Worksheets("EXO").Range("A1").PasteSpecial xlPasteValues
    XLBook.Worksheets("EXO").Range("A1").PasteSpecial xlPasteFormats

    ' Save and update the screen
    XLBook.SaveAs ("F:\path\Pivot_GOP_SCN_PAIR " & date_report & ".xlsx")
    XLBook.Close SaveChanges:=True
    Application.ScreenUpdating = True
End Sub

VBA 如何在新的工作簿中粘贴特殊保留格式

How to paste special preserving the format in a new WorkBook in VBA

format

excel

vba

paste