Copy entire sheet and paste as values

Question

I am trying to copy the active worksheet into a new workbook, then save that new workbook and close it. This is triggered by clicking on a form (button) in the active worksheet. The button is then removed in the new workbook prior to saving.

I am using formulas in the active worksheet. I am trying to copy only the values and any additional formatting.

The new workbook does not show the values, but instead only empty cells (no formulas are shown either, which is of course ok). Specifically, the problem seems to occur when copying cells with indirect formulas; it seems to be no problem for cells that use simpler references to other sheets in the original workbook.

Here's the code:

Sub CopyRemoveFormAndSave()
    Dim RelativePath As String
    Dim shp As Shape
    Dim testStr As String

    ' Copy and Paste Active Sheet
    ActiveSheet.Copy
    With ActiveSheet.UsedRange
        .Value = .Value
    End With

    ' Remove forms
    For Each shp In ActiveSheet.Shapes
        If shp.Type = 8 Then
            If shp.FormControlType = 0 Then
                testStr = ""
                On Error Resume Next
                testStr = shp.TopLeftCell.Address
                On Error GoTo 0
                If testStr <> "" Then shp.Delete
            Else
                shp.Delete
            End If
        End If
    Next shp

    ' Save New Workbook and Close
    Application.DisplayAlerts = False
    RelativePath = ThisWorkbook.Path & "\" & ActiveSheet.Name & "_Reporting_" & Format(Now, "yymmdd") & ".xlsx"
    ActiveWorkbook.SaveAs Filename:=RelativePath
    ActiveWorkbook.Close
    Application.DisplayAlerts = True

End Sub

Answer 1

Here is a slightly different approach.

Logic:

1. Create a copy of the active workbook in user's temp directory
2. Open the copy
3. Change formulas to values. The rest of the formatting remains untouched.
4. Delete all unnecessary sheets
5. Delete unnecessary shapes.

Code: (Tried and tested)

Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Private Const MAX_PATH As Long = 260

'~~> Function to get user's temp directoy
Function TempPath() As String
    TempPath = String$(MAX_PATH, Chr$(0))
    GetTempPath MAX_PATH, TempPath
    TempPath = Replace(TempPath, Chr$(0), "")
End Function

Sub CopyRemoveFormAndSave()
    Dim wb As Workbook, wbNew As Workbook
    Dim ws As Worksheet
    Dim wsName As String, NewName As String
    Dim shp As Shape

    Set wb = ThisWorkbook

    wsName = ActiveSheet.Name

    NewName = wsName & ".xlsm"

    wb.SaveCopyAs TempPath & NewName

    Set wbNew = Workbooks.Open(TempPath & NewName)

    wbNew.Sheets(wsName).UsedRange.Value = wbNew.Sheets(wsName).UsedRange.Value

    Application.DisplayAlerts = False
    For Each ws In wbNew.Worksheets
        If ws.Name <> wsName Then ws.Delete
    Next ws
    Application.DisplayAlerts = True

    For Each shp In wbNew.Sheets(wsName).Shapes
        If shp.Type = 8 Then shp.Delete
    Next

    '
    '~~> Do a save as for the new workbook if required.
    '
End Sub

Answer 2

This might be a bit late as an answer for you, but might help someone else in future.

Steps:

1. Go to the First Sheet in the Workbook
2. Hold Shift button and click on the Last Sheet in the Workbook (All your sheets are selected)
3. Select all cells in the active sheet by doing Ctrl+A+A, or, clicking the little arrow on the top left cusp of column A and row 1. (All cells in the active sheet are selected)
4. Copy >> Paste as Values

This copy pastes as values for all cells in all sheets. Save file As.