将工作表复制到新工作簿

• 如果将As Worksheet替换为As Object，则此过程也适用于图表。
• 若要引用上次打开的工作簿，可以安全地使用Workbook(Workbooks.Count)。
• 关闭Application.DisplayAlerts以覆盖而不进行确认。如果不执行此操作，则当文件存在时，系统将要求您保存它。如果选择No或Cancel，则会出现以下错误：
• 运行时错误'1004'：对象“_Workbook”的方法“另存为”失败 *
• 如果要引用工作表的工作簿，则可以使用.Parent属性。这样，该过程就不会仅限于包含此代码（ThisWorkbook）的工作簿。否则，请将Sheet.Parent替换为ThisWorkbook。
• 如果使用Application.PathSeparator而不是反斜杠（\），则此过程也可以在操作系统与Windows不同的计算机上运行。
• 对于新工作簿，默认类型为.xlsx，因此不需要指定文件扩展名或格式。

Sub SaveSheetAsXlsx(ByVal Sheet As Object)
    ' Copy the sheet to a new single-sheet workbook.
    Sheet.Copy
    ' Reference, save and close the new workbook.
    Dim nwb As Workbook: Set nwb = Workbooks(Workbooks.Count)
    Application.DisplayAlerts = False ' overwrite without confirmation
        nwb.SaveAs Sheet.Parent.Path & Application.PathSeparator & Sheet.Name
    Application.DisplayAlerts = True
    nwb.Close False
End Sub

set newWorkbook = workbooks.Add创建了一个新工作簿。但是不带参数的ws.Copy将ws复制到一个新工作簿。现在您有两个新工作簿，这显然不是您想要的。MS学习文档在其文档中提供了一个如何使用copy命令复制工作表的示例。参考：https://learn.microsoft.com/en-us/office/vba/api/excel.worksheet.copy

Sub foo()
    Call SaveWorksheetAsXlsx(Worksheets("Sheet3"))
End Sub

Sub SaveWorksheetAsXlsx(ws As Worksheet)
Dim filePath As String

    filePath = ThisWorkbook.Path & "\" & ws.Name & ".xlsx"
    If Not CreateObject("Scripting.FileSystemObject").FileExists(filePath) Then
        ws.Copy
        ActiveWorkbook.SaveAs filePath, FileFormat:=xlOpenXMLWorkbook
        ActiveWorkbook.Close SaveChanges:=False
    Else
        MsgBox "Error: unable to save file. File already exists: " + filePath
    End If
    
 End Sub

这显然依赖于预期的行为，即当您将工作表复制到新工作簿时，该工作簿将成为活动工作簿。（我猜很多年了），尽管依赖默认行为确实让我有点紧张，所以您可以考虑添加一些保护子句，也许只有当工作簿有空路径时才保存它（iIndie.E.，确保它是一个新添加的工作簿-〉if ActiveWorkbook.Path = ""。因此，编码预防性和非常谨慎：

Sub foo()
    Call SaveWorksheetAsXlsx(Worksheets("Sheet3"))
End Sub

Sub SaveWorksheetAsXlsx(ws As Worksheet)
Dim filePath As String

    filePath = ThisWorkbook.Path & "\" & ws.Name & ".xlsx"
    If Not CreateObject("Scripting.FileSystemObject").FileExists(filePath) Then
        ws.Copy
        If ActiveWorkbook.Path = "" Then 'Extra check to ensure this is a newly created and unsaved workbook
            ActiveWorkbook.SaveAs filePath, FileFormat:=xlOpenXMLWorkbook
            ActiveWorkbook.Close SaveChanges:=False
        Else
            MsgBox "Unexpected error attempting to save file " + filePath
        End If
    Else
        MsgBox "Error: unable to save file. File already exists: " + filePath
    End If
    
 End Sub