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

0
votes

I would like copy and paste special (values & format) a range from workbook A to workbook B. The problem is : the values are paste but not the format

I've tried all the PasteSpecial, but none of it worked...

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

So, how can I paste format from a workbook A to workbook B?

2
excelvbaformatpaste
XLBook.Worksheets("EXO").Range("P7:A24").PasteSpecial xlPasteValues XLBook.Worksheets("EXO").Range("P7:A24").PasteSpecial xlPasteFormats – Damian
Don't use .Activate and ActiveSheet. Instead work with the sheet directly Worksheets("Pivot EXO").PivotTables… • You might benefit from reading How to avoid using Select in Excel VBA. • Also always specify a sheet for all ranges Range("P7:A24").Copy otherwise you let Excel guess wich sheet to take. Specify it like Worksheets("Pivot EXO").Range("P7:A24").Copy – Pᴇʜ
@Damian I've tried but this doesn't work. I think the problem comes from the fact that i copy/paste values of pivot, or maybe the fact that i use Excel.Application.Workbooks.Add and so i don't use "open". – Hippolyte BRINGER

2 Answers

0
votes

Well basically the values in the pivot range your copying are not formatted at all, is only the pivot table style that shows them formatted.

One work around that would be to copy your values, then transform your copied values into a table and apply the same formatting your pivot table has (see comments for further details):

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
0
votes

I solved my problem.

The problem was that I create a new Excel.Application. With the code below, my paste special works fine.

But I don't understand why xlPasteFormats doesn't work when you paste in an other 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