Sub 另存所有工作表为工作簿()
    Dim sht As Worksheet
    Application.ScreenUpdating = False
    ipath = ThisWorkbook.Path & "\"
    For Each sht In Sheets
        sht.Copy
        ActiveWorkbook.SaveAs ipath & sht.Name & ".xls"  '(工作表名称为文件名）
        'ActiveWorkbook.SaveAs ipath & sht.Name & Trim(sht.[d15]) & ".xls"  '（文件名称 & D15单元内容）
        'ActiveWorkbook.SaveAs ipath & Trim(sht.[d15]) & ".xls"   '（文件名称为D15单元内容）
        ActiveWorkbook.Close
    Next
    Application.ScreenUpdating = True
End Sub

Sub 另存所有工作表为工作簿()
    Dim sht As Worksheet
    Application.ScreenUpdating = False
    ipath = ThisWorkbook.Path & "\"
    For Each sht In Sheets
        sht.Copy
        ActiveWorkbook.SaveAs ipath & sht.Name & ".xls"  '(工作表名称为文件名）
        'ActiveWorkbook.SaveAs ipath & sht.Name & Trim(sht.[d15]) & ".xls"  '（文件名称 & D15单元内容）
        'ActiveWorkbook.SaveAs ipath & Trim(sht.[d15]) & ".xls"   '（文件名称为D15单元内容）
        ActiveWorkbook.Close
    Next
    Application.ScreenUpdating = True
End Sub