Save in a new workbook four of five sheets which contains ActiveX controls

Question

My workbook A containing five sheets (Sheet1, Sheet2, Sheet3, Sheet4 and Sheet5). I protected the cells containing these formulas and now I want to save only Sheet1, Sheet2, Sheet3 and Sheet4 in the new workbook named "myfile".

Sub Protect()
    Dim pwd As String, s As Long
pwd = InputBox("entrer a password", Title:="Password")

With ThisWorkbook
    For s = 1 To 4
        With .Worksheets("Sheet" & s)
            .Copy
        End With

        With ActiveWorkbook
            for i=1 to 4 
With .Worksheets(i)
                .UsedRange
                On Error Resume Next    
                .Cells.SpecialCells(xlCellTypeBlanks).Locked = False
                .Cells.SpecialCells(xlCellTypeConstants).Locked = False
                .Columns("O").Hidden = True 'i want to hide it for each Sheet
                .Columns("P").Hidden = True 'i want to hide it for each Sheet
               .Columns("Q").Hidden = True  'i want to hide it for each Sheet
               .Columns("R").Hidden = True  'i want to hide it for each Sheet
               .Columns("S").Hidden = True  'i want to hide it for each Sheet
               .Columns("T").Hidden = True  'i want to hide it for each Sheet
               .Columns("U").Hidden = True  'i want to hide it for each Sheet
               .Columns("V").Hidden = True  'i want to hide it for each Sheet
                On Error GoTo 0
                .protect pwd, True, True, True, True
            End With
            next i
        End With
    Next s
End With
.SaveAs Filename:="myfile" & s, FileFormat:=xlOpenXMLWorkbook
.Close SaveChanges:=False


End Sub

I add .SaveAs Filename:="myfile" ActiveWorkbook.Close at the end but it doesnt work. How can I fixe it ?

At the moment, the above code does not reflect the actions you want to achieve according to your post. Furthermore, there are a few things you might want to address: (1) leading dots such as .Close outside a With statement (2) using .Copy without pasting it anywhere (3) using a With statement for only one line? (4) You mentioned in your post "saving" four sheets in "the" new sheet (implying one sheet). How do you want to go about that (cannot be seen in the above code)? — Ralph
@Ralph Sorry, i edit it. I want to save only Sheet1, Sheet2, Sheet3 and Sheet4 in the new workbook named "myfile". — John
Then you might want to add code to create a new workbook (in addition to possibly addressing the aforementioned problems). Also, there should be code to .Paste the sheets somewhere (not just copying them). — Ralph

0m3r 0m3r · Accepted Answer · 2016-05-09T19:18:25

To save 4 or 5 Sheets try using .Sheets(Array("Sheet1", "Sheet2")).Copy ' Or use SheetName then save it.

Here is an example on how to save certain sheets...

Option Explicit
Sub Email_Sheets_Ali()
    Dim SourceBook As Workbook
    Dim Book As Workbook
    Dim FilePath As String
    Dim FileName As String
    Dim TheActiveWindow As Window
    Dim TempWindow As Window

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set SourceBook = ActiveWorkbook

'   // Copy the sheets to a new workbook
'   // We add a temporary Window to avoid the Copy problem
'   // if there is a List or Table in one of the sheets and
'   // if the sheets are grouped
    With SourceBook
        Set TheActiveWindow = ActiveWindow
        Set TempWindow = .NewWindow
        .Sheets(Array("Sheet1", "Sheet2")).Copy ' Or use SheetName
    End With

'   // Close temporary Window
    TempWindow.Close

    Set Book = ActiveWorkbook

'   // Save the new workbook
    FilePath = "C:\Temp\"
    FileName = "MyFileName"

    With Book
        .SaveAs FilePath & FileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        .Close savechanges:=False
    End With

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

See Ron de Bruin on more examples and FileFormats

Save in a new workbook four of five sheets which contains ActiveX controls

1 Answers