Pasting Pivot Table as Values... losing Borders and formatting

Robert Stenz
Copper Contributor
Sep 18, 2018
Sept 18, 2018 - Here's VBA that copies values and formats for an entire sheet (including pivots) to a temporary sheet and saves that sheet as a new file with the same name as the tab. I'm a VBA hack, so any suggested improvements to this code are appreciated. Good luck and thanks in advance for any feedback on this coding.

Sub CopySheetsToFile()

'This macros copies the selected to sheet to a new sheet with similar formatting and with formulas/links/pivots removed

    Dim SourceSheet As Worksheet
    Dim TempSheet As Worksheet
    Dim NewName As String

    If MsgBox("Copy specific sheet to a new workbook" & vbCr & _
    "New sheet will be pasted as values, named ranges removed" _
    , vbYesNo, "NewCopy") = vbNo Then Exit Sub

    With Application
       .ScreenUpdating = False

'       Modified - Original Source:http://www.vbaexpress.com/kb/getarticle.php?kb_id=359
'       Copy active sheet

        Set SourceSheet = ActiveWorkbook.ActiveSheet

'   ***Insert new temporary sheet-per https://www.mrexcel.com/forum/excel-questions/607515-copy-paste-pivot-table-values-formatting.html

       Set TempSheet = ThisWorkbook.Worksheets.Add

       SourceSheet.Select
       Cells.Select
       Selection.Copy

       TempSheet.[A1].PasteSpecial Paste:=xlPasteValues

       SourceSheet.Select
       Cells.Select
       Selection.Copy

       TempSheet.[A1].PasteSpecial Paste:=xlPasteFormats

       Application.CutCopyMode = False

'      File name equal to sheet name
       TempSheet.Copy
       NewName = SourceSheet.Name

'      Formatting of TempSheet
       Range("A1").Select
       ActiveWindow.DisplayGridlines = False
       ActiveWindow.Zoom = 70
       ActiveSheet.Name = SourceSheet.Name

'     Save it with the NewName and in the same directory as original
        ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & NewName & ".xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False


        ActiveWorkbook.Close SaveChanges:=False

        .ScreenUpdating = True

'    ***Delete temporary Worksheet-This section may not be needed
       Application.DisplayAlerts = False
       TempSheet.Delete
       Application.DisplayAlerts = True
       Set TempSheet = Nothing

    End With
    Exit Sub

End Sub

'    ***NOTE 1: This macro should be saved with the Workbook (vs Personal Macro Workbook) for the resulting new file to be saved in the original directory.
'    ***NOTE 2: To work on a Mac, the above SaveAs command needs to be replaced by: ActiveWorkbook.SaveAs "Macintosh HD:Users:USERNAMEHERE:Desktop:DESKTOPFOLDERNAMEHERE:" & NewName & ".xlsx", FileFormat:=51

Forum Discussion

Pasting Pivot Table as Values... losing Borders and formatting

Resources