VBA实现工作表从原WB移至新WB，保存时文件崩溃求助

看起来你的代码思路没问题，但几个细节没处理到位，导致保存时Excel出现崩溃。我帮你梳理下问题根源，再给你修复后的代码：

问题根源分析 #

• 未恢复屏幕更新状态：你开头把Application.ScreenUpdating设为False，但全程没改回True，Excel界面一直处于后台冻结状态，保存操作时容易触发异常。
• 遍历集合时直接删除元素：在For Each ws In oldwb.Sheets循环里直接删除ws，会破坏正在遍历的工作表集合，导致内存引用混乱。
• 未处理原工作簿未保存的情况：如果原工作簿oldwb还没保存过，oldwb.Path会是空值，SaveAs时会直接报错，进而引发崩溃。
• 默认工作表删除时机不合理：你在复制完所有工作表后才删除Sheet1，但如果新工作簿只剩Sheet1就删除，即便关闭了警告，也可能留下潜在的引用问题。

修复后的代码 #

Sub MoveSheets01()
    Dim ws As Worksheet
    Dim newWB As Workbook
    Dim oldwb As Workbook
    Dim sheetsToMove As Collection
    Dim sheetItem As Variant
    
    ' 用集合存储要移动的工作表，避免遍历中删除元素的问题
    Set sheetsToMove = New Collection
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False ' 统一关闭警告，减少重复开关操作
    
    Set oldwb = ActiveWorkbook
    
    ' 先筛选出要移动的工作表，存入集合
    For Each ws In oldwb.Sheets
        If ws.Name <> "Input" And ws.Name <> "Output" Then
            sheetsToMove.Add ws
        End If
    Next ws
    
    ' 创建仅含1个空白工作表的新工作簿，省去删除默认多工作表的步骤
    Set newWB = Application.Workbooks.Add(xlWBATWorksheet)
    
    ' 执行复制和删除操作
    For Each sheetItem In sheetsToMove
        sheetItem.Copy After:=newWB.Sheets(newWB.Sheets.Count)
        sheetItem.Delete
    Next sheetItem
    
    ' 保存原工作簿
    oldwb.Save
    
    ' 处理新工作簿的保存路径，兼容原工作簿未保存的情况
    Dim savePath As String
    If oldwb.Path = "" Then
        ' 原工作簿未保存时，弹出对话框让用户选择保存路径
        savePath = Application.GetSaveAsFilename( _
            FileFilter:="Excel Workbook (*.xlsx), *.xlsx", _
            Title:="选择新工作簿保存路径", _
            InitialFileName:="AAA " & Format(Now(), "DD.MMM.YYYY hh.mm AMPM") & ".xlsx")
        If savePath <> "False" Then ' 用户确认保存路径
            newWB.SaveAs Filename:=savePath, CreateBackup:=False
        End If
    Else
        newWB.SaveAs Filename:=oldwb.Path & "\AAA " & Format(Now(), "DD.MMM.YYYY hh.mm AMPM") & ".xlsx", CreateBackup:=False
    End If
    
    ' 恢复Excel的默认交互状态
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    ' 可选：激活新工作簿
    newWB.Activate
End Sub

关键修改点说明 #

• 引入Collection存储要移动的工作表，避免遍历原集合时直接删除元素引发的引用错误。
• 创建新工作簿时使用xlWBATWorksheet参数，只生成一个空白工作表，省去删除默认多工作表的操作。
• 统一管理Application.DisplayAlerts，减少重复开关的冗余操作。
• 增加了原工作簿未保存时的路径处理逻辑，避免SaveAs因空路径报错。
• 最后恢复ScreenUpdating和DisplayAlerts到默认状态，确保Excel回到正常交互模式。

你可以试试这个版本，应该能解决保存崩溃的问题。

内容的提问来源于stack exchange，提问作者Swat