创build新的工作簿并复制/粘贴。 更快的解决scheme?

目前下面的代码工作正常,但是原来的“filelocation1”暂时打开,最终用户在一秒钟之内就可以看到它。 有没有办法做同样的事情,但它运行得更快和/或可能永远不会打开原来的工作簿?

vba:

Private Sub CommandButton1_Click() Dim wbI As Workbook, wbO As Workbook Dim wsI As Worksheet, wsO As Worksheet Dim filelocation1 As String Dim filelocation2 As String filelocation1 = Environ("USERPROFILE") & "\Desktop" & "\" & Format(Date, "ddmmyyyy") & ".xls" filelocation2 = "\\file\nextfile\fileafterthat\etc" & "\" & Format(Date, "ddmmyyyy") & Application.UserName & ".xls" Set wbI = ThisWorkbook Set wsI = wbI.Sheets("Production") Set wbO = Workbooks.Add Application.DisplayAlerts = False With wbO Set wsO = wbO.Sheets("Sheet1") ActiveWorkbook.SaveAs Filename:=filelocation1, FileFormat:=56 wsI.Range("A1:C100").Copy wsO.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ActiveWorkbook.Save ActiveWorkbook.Close End With FileCopy Source:=filelocation1, Destination:=filelocation2 Application.DisplayAlerts = True End Sub 

Application.ScreenUpdating = False