Saving a copy of just one worksheet + remove buttons

JumboCactuar

Well-known Member
Joined
Nov 16, 2016
Messages
609
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

Well-known Member
Joined
Apr 11, 2012
Messages
8,422
Try:
Code:
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

Well-known Member
Joined
Nov 16, 2016
Messages
609
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

Well-known Member
Joined
Apr 11, 2012
Messages
8,422
Try:
Code:
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
 

Forum statistics

Threads
1,077,920
Messages
5,337,196
Members
399,131
Latest member
Vinnyjuice

Some videos you may like

This Week's Hot Topics

Top