将工作表移动到可见的Excel实例

我在工作簿中创build了一个用户窗体。 当工作簿被打开时，这是运行的代码：

Private Sub Workbook_Open() Application.Visible = False UserForm1.Show End Sub 

所以现在用户只能看到Userform。 用户窗体上有一个button，用于在不可见的运行工作簿中创build工作表，以及我的主要目标：

（1）打开Excel的新实例

（2）将Excel的新实例设置为可见（ Application.Visible = True ）

（3）将工作表从不可见实例移动到新创build的可见实例。

这是我尝试运行没有成功的代码：

 Sub Move() ' Check if there is a sheet named "Data Sheet" For Each s In ThisWorkbook.Sheets If Not s.Name <> "Data Sheet" Then ' if true then create new excel instance Dim oXLApp As Object, wb As Object Dim ws As Worksheet Set oXLApp = CreateObject("Excel.Application") oXLApp.Visible = True Set wb = oXLApp.Workbooks.Add 'move the sheet "Data Sheet" to new workbook s.Move Before:=wb.Sheets(1) 'delete all sheets in new workbook except "Data Sheet" Application.DisplayAlerts = False With wb For Each ws In Worksheets If ws.Name <> "Data Sheet" Then ws.Delete Next End With Application.DisplayAlerts = True End If Next s End Sub 

我设法将工作表移动到一个新的工作簿，但在同一个不可见的Excel实例使用下面的代码：

 Sub Move2() Dim newWb As Workbook Dim ws As Worksheet For Each s In ThisWorkbook.Sheets If Not s.Name <> "To Do" Then Dim sheetName As String sheetName = s.Name Set newWb = Workbooks.Add s.Move Before:=newWb.Sheets(1) Application.DisplayAlerts = False With newWb For Each ws In Worksheets If ws.Name <> "To Do" Then ws.Delete Next End With Application.DisplayAlerts = True End If Next s End Sub 

我的错误是什么，什么是一个好的解决方法？

Answer 1

如上面的注释中所述，您不能将工作表移动到不同的Excel实例。 这是一个解决方法。

我们将使用.SaveCopyAs方法保存现有工作簿的副本。 你可以阅读更多关于.SaveCopyAs 这里

逻辑

1. 在用户的临时目录中使用.SaveCopyAs保存现有工作簿的副本。
2. 在一个新的Excel实例中打开副本并删除不需要的表单。
3. < 可选步骤 >重新将文件（如果需要）保存在.xlsx的新位置以删除所有macros。

代码（TRIED AND TESTED）

 Option Explicit Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _ (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Private Const MAX_PATH As Long = 260 Dim TempFile As String Sub MoveSheet() Dim oXLApp As Object, wb As Object, ws As Object TempFile = TempPath & "MyFile.xlsm" On Error Resume Next Kill TempFile On Error GoTo 0 ThisWorkbook.SaveCopyAs TempFile Set oXLApp = CreateObject("Excel.Application") Set wb = oXLApp.Workbooks.Open(TempFile) oXLApp.DisplayAlerts = False For Each ws In wb.Worksheets If ws.Name <> "Data Sheet" Then ws.Delete Next '~~> Optional step to re save the file as xlsx wb.SaveAs "C:\MyNewFile.xlsx", 51 oXLApp.DisplayAlerts = True oXLApp.Visible = True End Sub '~~> Function to get the user's temp directory Function TempPath() As String TempPath = String$(MAX_PATH, Chr$(0)) GetTempPath MAX_PATH, TempPath TempPath = Replace(TempPath, Chr$(0), "") End Function