将工作表移动到新工作簿的速度较慢

Question

我有一个相当长的宏。最后一步是将五张新工作表移到一个新工作簿中。这需要几分钟的时间。

我已经隔离了这个部分。

Application.Calculation = xlManual
Dim TempSheets As Variant
TempSheets = Array(Sheets to be moved...)
Sheets(TempSheets).Move
Application.Calculation = xlAutomatic

当我关闭屏幕更新时，它的速度只需要10秒左右。但是新的工作表却找不到了。

作为另一种想法，我尝试先命名一个新的工作表：

Dim newwb As Workbook
Set newwb = Workbooks.Add

但是，如果不先保存并命名，就无法获得将工作表移动到新工作簿的正确语法。我试过了：

Sheets(TempSheets).Move Before:=newwb.Sheets("Sheet1")

我可以使用Set newwb = Workbooks.add创建一个新的工作簿，该工作簿在关闭屏幕更新的情况下是可见的。

Answer 1

Dim NewWb As Workbook
Set NewWb = Application.Workbooks.Add
Dim TempSheets As Variant
TempSheets = Array("Sheet1", "Sheet2")
Application.ScreenUpdating = False
Application.Calculation = xlManual
Dim StartTmr As Double  'this is just to measure the time it needs
StartTmr = Timer
'move the sheets before the first sheet in the new workbook
ThisWorkbook.Worksheets(TempSheets).Move Before:=NewWb.Sheets(1)
Debug.Print "After Move: ", Timer - StartTmr  'time needed for moving
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Debug.Print "After Calc: ", Timer - StartTmr  'time needed for moving and calculating

这对我来说非常有效，而且只需几毫秒。看看它，看看它所花费的长时间是否真的是移动代码或重新打开计算。检查即时窗口中的输出，它应该类似于：

After Move:    0,265625 
After Calc:    0,296875 

Answer 2

在处理类似问题时，我通过解决了它

用具体名称声明原始工作簿和新工作簿，例如wbOrig和wbNew2.使用.SaveAs方法将原始工作簿保存在新工作簿的名称下3.将wbNew设置为刚制作的副本4.如有必要，删除不需要的纸张

Dim wbOrig As Workbook
Dim wbNew As Workbook
Dim strPath As String 'the path to your new wb
Dim strFileName As String  ' the name of your new wb
Set wbOrig = Workbooks("YourWorkbooksName.xlsm")
wbOrig.SaveAs Filename:=strPath & strFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Set wbNew = Workbooks(strFileName)
' if necessary, you can delete all sheets you do not need here now

也许不是最优雅的方式，但有效，当然需要不到10分钟的时间。