将工作表复制到（一个工作表的）新工作簿而不打开它

Question

我想将 ActiveWorkbook 中的工作表复制到新建工作簿。 新创建的工作簿将包含复制的工作表ONLY。

我也不希望它在复制工作表时打开。我想将工作表静默复制到新创建的工作簿中。

如果我执行以下操作，则新创建的书有 3 张，而不仅仅是一张，并且在复印时会打开。它还问我是否想用宏保存它，而我只想复制 sheet1，所以不需要任何宏，如何解决它以满足我的需要？

ThisWorkbook.Sheets("Sheet1").Copy
ActiveWorkbook.SaveAs "C:\DestinationWb.xlsx", FileFormat:=51

Answer 1

必须打开新创建的工作簿 - 否则您将如何保存它？ - 但切换Application.ScreenUpdating 可能会促进您正在寻找的“无声”副本。切换Application.DisplayAlerts 也会根据需要抑制警报。

Application.ScreenUpdating = False
Application.DisplayAlerts = False

ThisWorkbook.Sheets("Sheet1").Copy
ActiveWorkbook.SaveAs FileName:="C:\DestinationWb.xlsx", FileFormat:=51
ActiveWorkbook.Close

Application.DisplayAlerts = True
Application.ScreenUpdating = True

Answer 2

您好，我刚刚尝试了您提供的代码，它仍然打开书本大约 1-2 秒并关闭它。用户将清楚地看到这本书已打开。有没有其他方法，而不是强制 sheet.copy 或者它是复制的唯一方法？ – JustGreat 50 分钟前

在这种情况下我能想到的唯一方法是执行以下操作。

逻辑：

1. 使用.SaveCopyAs 方法保存现有工作簿的副本。你可以阅读更多关于.SaveCopyAsHERE
2. 创建另一个 Excel 实例并将其隐藏
3. 在该实例中打开副本
4. 删除所有工作表，您想要的工作表除外。
5. 保存并关闭，最后退出 Excel 实例。

代码：

Sub Sample()
    Dim thisWb As Workbook

    '~~> New File Name
    Dim NewFile As String
    NewFile = "C:\Users\routs\Desktop\New folder\DestinationWb.xlsx"

    '~~> Sheets that you want to copy across
    Dim SheetToCopy As String
    SheetToCopy = "Sidd"

    Set thisWb = ThisWorkbook

    '~~> Save a copy of the current workbook to the new path
    thisWb.SaveCopyAs NewFile

    '~~> Create a new Excel instance and keep it hidden
    Dim tmpExcelApp As Object
    Dim ws As Object, thatWb As Object
    Set tmpExcelApp = CreateObject("Excel.Application")
    tmpExcelApp.Visible = False

    '~~> Open the copy file in hidden instance
    Set thatWb = tmpExcelApp.Workbooks.Open(NewFile)

    '~~> Delete all sheets except the one we copied
    tmpExcelApp.DisplayAlerts = False
    For Each ws In thatWb.Worksheets
        If ws.Name <> SheetToCopy Then ws.Delete
    Next ws
    tmpExcelApp.DisplayAlerts = True

    '~~> Save and close
    thatWb.Close (True)

    '~~> Quit Excel Instance
    tmpExcelApp.Quit

    MsgBox "Done"
End Sub