亦有资源网

在键盘按下ALT+F11，左侧【工程】窗口，右击插入【模块】

在右侧窗口复制如下代码：

Sub 工作表另存为工作簿()
    Dim sh As Worksheet, path$
    path = ActiveWorkbook.path & "\" '设置工作簿保存路径
    Application.ScreenUpdating = False '关闭屏幕更新
    For Each sh In ActiveWorkbook.Worksheets: '遍历当前宏所在的工作簿中的工作表
        sh.Copy '复制工作表
        ActiveWorkbook.SaveAs Filename:=path & sh.Name & ".xlsx" '保存活动工作簿
        ActiveWorkbook.Close '关闭活动工作簿
    Next
    Application.ScreenUpdating = True '开启屏幕更新
    MsgBox "工作表另存为工作簿已完成"
End Sub

注意，上述代码使用了 ActiveWorkbook 对象，表示当前活动的工作簿。代码执行的时候要将需要执行的工作簿至于活动状态。