新しいブックに保存ActiveXコントロールを含む5枚のうち4枚

Question

5枚（Sheet1、Sheet2、Sheet3、Sheet4、Sheet5）のブックを含むブック。私はこれらの数式を含むセルを保護し、今は "myfile"という名前の新しいブックにSheet1、Sheet2、Sheet3、およびSheet4のみを保存したい。最後に= "myfileの" ActiveWorkbook.Closeが、それは仕事をdoesntの：

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 

私は.SaveAsファイル名を追加します。どうすれば修正できますか？

Answer 1

シートを4枚または5枚保存するには、.Sheets(Array("Sheet1", "Sheet2")).Copy ' Or use SheetNameを使用して保存してください。ここで

は、現時点では

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