修改工作表另存为工作薄的代码，使之无限延续

cmccsq

下面是网上下载的工作表另存为工作薄的代码，如何实现新存的工作薄也带模块代码，可以继续另存为另外的工作薄。

Sub newbooks()
    Dim sht As Worksheet, mypath$
    Application.DisplayAlerts = False
    '取消显示系统警告和消息
    Application.ScreenUpdating = False
    '取消屏幕刷新
    With Application.FileDialog(msoFileDialogFolderPicker)
   '选择保存工作薄的文件路径
        .AllowMultiSelect = False
        '不允许多选
        If .Show Then
            mypath = .SelectedItems(1)
            '读取选择的文件路径
        Else
            Exit Sub
            '如果没有选择保存路径，则退出程序
        End If
    End With
    If Right(mypath, 1) <> "\" Then mypath = mypath & "\"

For Each sht In ActiveWindow.SelectedSheets '对选定的工作表进行操作
'For Each sht In Worksheets
    '遍历工作表 上下二句二选一
        sht.Copy
        '复制工作表，工作表单纯复制后，成为活动工作薄
        With ActiveWorkbook
            .SaveAs mypath & sht.Name, xlWorkbookDefault
            '保存活动工作薄到指定路径下
            .Close True '关闭工作薄
        End With
    Next
    MsgBox "处理完成。", , "提醒"
    Application.ScreenUpdating = True '恢复屏幕刷新
    Application.DisplayAlerts = True '恢复显示系统警告和消息
End Sub

liulang0808

.SaveAs mypath & sht.Name, xlWorkbookDefault
另存为xlsm格式看看，具体另存代码可以自行录制

cmccsq

liulang0808 发表于 2018-8-27 11:11
.SaveAs mypath & sht.Name, xlWorkbookDefault
另存为xlsm格式看看，具体另存代码可以自行录制

谢谢，试过了，另存为xlsm后，代码模块还是没有的。

liulang0808

cmccsq 发表于 2018-8-27 11:59
谢谢，试过了，另存为xlsm后，代码模块还是没有的。

模块的跟着工作薄走的，
表格对应区域的代码可以跟着走的