Saving a copy of just one worksheet + remove buttons

[JumboCactuar]

Hi,
I have a workbook which I use savecopyas often and with a file size of around 6MB, it's using up space fast.

Source workbook contains many sheets/macros/formulas

And I only need to save 1 sheet (Main) to a new workbook and remove buttons + turn sheet to values if possible. Note the sheet is protected but no password

What is the best way to do this?

Thanks

 

[mumps]

Try:

Sub SaveMain()
    Application.ScreenUpdating = False
    Dim sh As Shape
    Sheets("Main").Copy
    With ActiveSheet
        .Unprotect
        .UsedRange.Cells.Value = .UsedRange.Cells.Value
        For Each sh In .Shapes
            sh.Delete
        Next sh
        .Protect
        .EnableSelection = xlUnlockedCells
    End With
    With ActiveWorkbook
        .SaveAs Filename:="[COLOR="#FF0000"]C:\Test\[/COLOR]" & [COLOR="#0000FF"]ActiveWorkbook.Name[/COLOR], FileFormat:=51
        .Close False
    End With
    Application.ScreenUpdating = True
End Sub

Change the folder path (in red) and the workbook name (in blue) to suit your needs.

 

[JumboCactuar]

Thanks @mumps

this works (almost perfect)

it currently deletes all buttons, but also deletes the textbox's i have on the sheet which i want to keep
is there any way to skip textboxe's in the loop ?

 

[mumps]

Try:

Sub SaveMain()
    Application.ScreenUpdating = False
    Dim sh As Shape, sh2 As Shape, srcWS As Worksheet, sName As String
    Set srcWS = ThisWorkbook.Sheets("Main")
    With srcWS
        .Unprotect
        .Copy
    End With
    With ActiveSheet
        .Unprotect
        .UsedRange.Cells.Value = .UsedRange.Cells.Value
        For Each sh In srcWS.Shapes
            sName = sh.Name
            sh.Copy
            ActiveSheet.Paste
            Set sh2 = .Shapes(.Shapes.Count)
            sh2.Name = sName
            sh2.Top = sh.Top
            sh2.Left = sh.Left
        Next sh
        For Each sh In .Shapes
            If Left(sh.Name, 7) <> "TextBox" Then
                sh.Delete
            End If
        Next sh
        .Protect
        .EnableSelection = xlUnlockedCells
    End With
    With ActiveWorkbook
        .SaveAs Filename:="C:\Test\" & ActiveWorkbook.Name, FileFormat:=51
        .Close False
    End With
    Application.ScreenUpdating = True
End Sub