ActiveWorkbook.SaveAs randomly shows saving loading popup but doesn't actually save

Question

I have a random issue I'm running into about once or twice a day, on a script that runs every 2 minutes from 7am to 5pm daily, and am hoping somebody here might be able to determine what could be causing it.

I'm going to try and keep this post as organized and to the point as possible, as the process utilizes 3 separate scripts.

Script #1 is housed in the PERSONAL.XLSB workbook & is the timer to begin the process @ 7am and repeat every 120 seconds. Code below:

**ThisWorkbook:
Private Sub Workbook_Open()
Application.OnTime TimeValue("07:00:00"), "'RunScripts2'"
End Sub

**Module1:
Sub RunScripts2()
On Error Resume Next
Shell "wscript ""R:\xxxx\xxxx\xxxx\scripts2.vbs""", vbNormalFocus
Dim scr As ScriptControl: Set scr = New ScriptControl
scr.Language = "VBScript"
Application.OnTime DateAdd("s", 120, Now), "RunScripts2"
End Sub

Script #2 is the scripts2.VBS script that Script #1 calls every 120 seconds. This opens an excel workbook and runs the macro "RunCopyPaste." Code below:

**scripts2.vbs:
Option Explicit
On Error Resume Next
ExcelMacroExample
Sub ExcelMacroExample() 

  Dim xlApp 
  Dim xlBook 
  Set xlApp = GetObject(,"Excel.Application") 
  xlApp.Visible = True
  xlApp.DisplayAlerts = False

  Set xlBook = xlApp.Workbooks.Open("\\xxxx\xxxx\xxxx\Model.xlsm",3,True) 

  Dim dteWait
  dteWait = DateAdd("s", 8, Now())
  Do Until (Now() > dteWait)
  Loop

  xlApp.Run "RunCopyPaste"

  Set xlApp = GetObject(,"Excel.Application") 

End Sub

Script #3 is housed in the Model.xlsm workbook that Script #2 calls. Code below:

**ThisWorkbook:
Private Sub Workbook_Open()
    Application.Run "BloombergUI.xla!RefreshAllWorkbooks"
    Application.Run "BloombergUI.xla!RefreshAllStaticData"
End Sub

**Module2:
Sub RunCopyPaste()
    On Error Resume Next
    Application.DisplayAlerts = False

    ChDir _
        "R:\xxxx\xxxx\xxxx\xxxx\"
    Workbooks.Open Filename:= _
        "R:\xxxx\xxxx\xxxx\xxxx\Data.xlsx" _
        , UpdateLinks:=3, ReadOnly:=True
    Application.Run "ConnectChartEvents"
    Windows("Model.xlsm").Activate
    Sheets("Sheet1").Select
    Range("B5:J94").Select
    Selection.Copy
    Windows("Data.xlsx").Activate
    Sheets("Sheet1").Select
    Range("B5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Windows("Model.xlsm").Activate
    Sheets("Sheet2").Select
    Range("C5:D73").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Data.xlsx").Activate
    Sheets("Sheet2").Select
    Range("C5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Windows("Model.xlsm").Activate
    Sheets("Sheet3").Select
    Range("B6:C7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Data.xlsx").Activate
    Sheets("Sheet3").Select
    Range("B6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False


FN = Replace(ActiveWorkbook.Name, "temp_", "")
FN = "temp_" + FN

ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path + Application.PathSeparator + FN

    ActiveWindow.Close False
    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    Sheets("Sheet1").Select
    ActiveWorkbook.Close
Dim wb As Workbook
Set wb = Workbooks.Add

End Sub

Issue I am currently facing

This process works great; however, once it breaks during the SaveAs "temp_Data.xlsx" process it wont save correctly unless I kill excel and restart the "RunScripts2" macro. The break usually occurs in the middle of the day, somewhere between 12-2pm. It's completely random. Here's exactly what happens: the process will run as expected but when it gets to the SaveAs "temp_Data.xlsx" it will show the loading bar displaying the saving progress much quicker than usual (~.2 seconds) and then close all workbooks, open a blank one just as it should and then repeat the process 120 seconds later. However, I noticed that the "temp_Data.xlsx" shows a Date Modified reflective of a previous run. And every subsequent run once it "breaks" will look like it runs as normal but the file will not be fully saved down and the file Date Modified will not reflect an updated run. My remedy has been to close excel and reopen it and manually kick off the "RunScripts2" macro to get the timer & process going again. I've had days where it goes the entire day without "breaking" and I've had some where it breaks multiple times in a day; however, most recently it breaks once mid-day and I restart it and it's fine until EOD.

Solutions I've Attempted Unsuccessfully I've tried keeping the alerts set to True but even that doesn't show any issues with the saving process. It's like it acts like it's saving but it doesn't really save. It's bizarre. I've done quite a bit of research on it and haven't found any solutions. I'm hoping somebody here has encountered something similar.

Many thanks in advance for any help!

UPDATED CODE BELOW

Seems to be working as of now... any further efficiencies I can make? Much appreciated.

scripts2 NEW.vbs:

Option Explicit
ExcelMacroExample
Sub ExcelMacroExample() 

Dim xlApp
Dim CopyFrom

Set xlApp = GetObject(,"Excel.Application") 
xlApp.Visible = True

Set CopyFrom = xlApp.Workbooks.Open("\\xxxx\xxxx\xxxx\Model NEW.xlsm",3,True) 

Dim dteWait
dteWait = DateAdd("s", 5, Now())
Do Until (Now() > dteWait)
Loop

CopyFrom.WorkSheets("Data").Activate()
CopyFrom.Worksheets("Data").Range("B1:K275").Copy
CopyFrom.Worksheets("Data").Range("B1").PasteSpecial -4163, -4142, False, False
xlApp.CutCopyMode = False

xlApp.DisplayAlerts = False
CopyFrom.SaveAs "\\xxxx\xxxx\xxxx\Model NEW.xlsx", 51
xlApp.DisplayAlerts = True

CopyFrom.Close False

Dim xlAppp
Set xlAppp = GetObject(,"Excel.Application") 
xlAppp.Visible = True

End Sub