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

【问题标题】：How to paste special preserving the format in a new WorkBook in VBA如何在 VBA 的新工作簿中粘贴特殊保留格式
【发布时间】：2019-05-27 23:23:13
【问题描述】：

我想复制并粘贴从工作簿 A 到工作簿 B 的特殊范围（值和格式）。问题是：值是粘贴而不是格式

我已经尝试了所有的 PasteSpecial，但都没有奏效...

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 中的 format 粘贴到工作簿 B 中？

【问题讨论】：

XLBook.Worksheets("EXO").Range("P7:A24").PasteSpecial xlPasteValues XLBook.Worksheets("EXO").Range("P7:A24").PasteSpecial xlPasteFormats
不要使用.Activate 和ActiveSheet。而是直接使用工作表Worksheets("Pivot EXO").PivotTables… • 您可能会从阅读How to avoid using Select in Excel VBA 中受益。 • 还要始终为所有范围指定一个工作表Range("P7:A24").Copy，否则您会让 Excel 猜测要使用哪个工作表。指定为Worksheets("Pivot EXO").Range("P7:A24").Copy
@Damian 我试过了，但这不起作用。我认为问题出在我复制/粘贴数据透视值的事实，或者我使用 Excel.Application.Workbooks.Add 的事实，所以我不使用“打开”。

标签： excel vba format paste

【解决方案1】：

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

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

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

【讨论】：

感谢您的回答。但是当枢轴的样式被格式化时，所有的案例都被格式化了。我已经解决了我的问题，问题是我创建了一个新的“Excel.Application”。使用Set XLBook = Workbooks.Add 粘贴特殊效果很好！

【解决方案2】：

我解决了我的问题。

问题是我创建了一个新的Excel.Application。使用下面的代码，我的特殊粘贴效果很好。

但我不明白为什么 xlPasteFormats 在您粘贴到其他 Excel.Application 时不起作用...

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

【讨论】：