Creating New Workbooks and copy/paste. Faster possible solution?

Question

Currently the code below works fine, but however the original "filelocation1" opens temporarily and its noticeable to the end user for a split second. Is there a way to do the same thing but it run faster and/or possibly never have the original workbook open in the first place?

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

Answer 1

Application.ScreenUpdating = False