将工作表复制到新工作簿时遇运行时错误问题求助

核心问题分析 #

1. 逻辑冲突导致空工作簿+报错：你先通过Workbooks.Add创建了空工作簿newWorkbook，但执行ws.Copy（不带参数）时，VBA会自动新建一个独立的新工作簿来存放复制的工作表，而你后续保存的还是最初创建的空工作簿；同时如果工作表存在保护、原工作簿未保存等情况，ws.Copy会直接触发运行时错误。
2. 潜在路径错误：如果原工作簿从未保存过，ThisWorkbook.Path会返回空字符串，拼接文件路径时会生成无效路径，也可能引发错误。

方案一：最简正确写法（推荐） #

直接利用ws.Copy自动生成目标工作簿，无需提前创建空簿，逻辑更清晰：

Sub SaveWorksheetAsXlsx(ws As Worksheet)
    Dim filePath As String
    
    ' 处理原工作簿未保存的情况，避免无效路径
    If ThisWorkbook.Path = "" Then
        MsgBox "请先保存当前工作簿，再执行此操作！", vbExclamation
        Exit Sub
    End If
    
    filePath = ThisWorkbook.Path & "\" & ws.Name & ".xlsx"
    
    ' 复制工作表到新工作簿（不带参数会自动生成新工作簿）
    ws.Copy
    
    ' 操作刚生成的新工作簿
    With ActiveWorkbook
        .SaveAs filePath, FileFormat:=xlOpenXMLWorkbook
        .Close SaveChanges:=False
    End With
End Sub

方案二：指定复制到已创建的工作簿（按需使用） #

如果需要控制工作表复制的位置，或在新工作簿中保留其他内容，可以用这种方式，同时处理工作表保护等可能的报错点：

Sub SaveWorksheetAsXlsx(ws As Worksheet)
    Dim filePath As String
    Dim newWorkbook As Workbook
    
    If ThisWorkbook.Path = "" Then
        MsgBox "请先保存当前工作簿，再执行此操作！", vbExclamation
        Exit Sub
    End If
    
    filePath = ThisWorkbook.Path & "\" & ws.Name & ".xlsx"
    
    Set newWorkbook = Workbooks.Add
    
    ' 若工作表被保护，先解除（有密码则添加Password参数）
    If ws.ProtectContents Then
        ws.Unprotect ' 示例：ws.Unprotect Password:="123456"
    End If
    
    ' 复制工作表到新工作簿的第一个工作表之后
    ws.Copy After:=newWorkbook.Worksheets(1)
    
    ' 删除新工作簿默认的空工作表（避免最终文件有多余空表）
    Application.DisplayAlerts = False
    newWorkbook.Worksheets(1).Delete
    Application.DisplayAlerts = True
    
    newWorkbook.SaveAs filePath, FileFormat:=xlOpenXMLWorkbook
    newWorkbook.Close SaveChanges:=False
    
    ' 恢复工作表保护（如果之前解除过）
    If Not ws.ProtectContents Then
        ws.Protect ' 示例：ws.Protect Password:="123456"
    End If
End Sub

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