寻求老师帮助：关于选择工作表另存为工作簿的问题，【重点自动关闭窗体】

糖↗小冷

寻求老师帮助：
点击【另存为】按钮后，

要求：只选择【主界面】【食堂】两个工作表另存为一个新的工作簿，

工作簿名称以Q5 R5单元格内容及年月日小时分秒命名，

自动保存在E盘，以Q3 R3单元格内容为名称的文件夹内，


重点是【另存的新工作簿打开后不执行直接弹出窗体】

糖↗小冷

ActiveWorkbook.Save
Dim oFso As Object, FolderPath
  Sheets("配合比第一联存根").Select
FolderPath = "E:\" & Range("j4") & "\"
Set oFso = CreateObject("Scripting.FileSystemObject")
With oFso
If .FolderExists(FolderPath) Then

Else
.CreateFolder FolderPath
End If
End With
Dim d
Dim sh
Dim Activelorkbook
  Set d = CreateObject("scripting.dictionary")
For Each sh In Sheets
If sh.Name <> "主界面" And sh.Name <> "配合比第一联存根" And sh.Name <> "配合比第二联委托" And sh.Name <> "配合比第三联传递" And sh.Name <> "开始" And sh.Name <> "参数库" And sh.Name <> "检测项目" And sh.Name <> "常规检测项目信息" And sh.Name <> "配合比项目信息" And sh.Name <> "发送微信给指定人" And sh.Name <> "发送微信给指定人配合比" Then
d(sh.Name) = ""
End If
Next sh
If d.Count > 0 Then
Sheets(d.keys).Copy
With Activelorkbook
For Each sh In Worksheets
sh.UsedRange.Value = sh.UsedRange.Value
Next
Application.DisplayAlerts = False
ActiveWorkbook.SaveCopyAs FolderPath & Range("S6") & Format(Now(), "YYYY-MM-DD-HH-MM") & ".xls"
Application.DisplayAlerts = False
ActiveWindow.Close
End With
Else
Exit Sub
End If
MsgBox "已保存在" & FolderPath & "文件夹"
End Sub


自问自答  测试好用