Макрос запускается при обновлении RTD

Question

Моя проблема заключается в следующем:

Я использую сервер данных в реальном времени с обратным отсчетом от 900 до 0. Как только обратный отсчет достигнет 5, я хочу, чтобы Excel скопировал диапазон (от B2 до B61) в лист (RTD_NEWS) и вставил его в новый лист в качестве значений.

Проблема в том, что мой макрос не будет делать это автоматически, когда оставшееся время достигнет 5. Если я нажму run, когда ячейка равна 5, он будет работать правильно.

Я сделал 2 макроса, где первый должен запускаться так, как я хочу, а второй работает, если я изменяю ячейку вручную, но не с помощью RTD-ссылок.

Первый макрос:

Function Test()
Dim TimeRemaining As Long
TimeRemaining = ActiveWorkbook.Sheets("RTD_NEWS").Range("D2")
If TimeRemaining = 5 Then
Application.Goto ActiveWorkbook.Sheets("RTD_NEWS").Range("B2", "B61")
Selection.Copy
Worksheets.Add
Application.Goto ActiveSheet.Range("B21")
ActiveCell.PasteSpecial (xlPasteValues)
Application.Wait Now + TimeValue("00:00:06")
End If
End Function

Второй макрос:

Sub auto_open()
   ' Run the macro DidCellsChange any time a entry is made in a
   ' cell in Sheet1.
   ThisWorkbook.Worksheets("RTD_NEWS").OnEntry = "DidCellsChange"
End Sub
Sub DidCellsChange()
  Dim KeyCells As String
   ' Define which cells should trigger the KeyCellsChanged macro.
   KeyCells = "D2"
   ' If the Activecell is one of the key cells, call the
   ' KeyCellsChanged macro.
   If Not Application.Intersect(ActiveCell, Range(KeyCells)) _
   Is Nothing Then KeyCellsChanged
End Sub
Sub KeyCellsChanged()
   Dim Cell As Object

    For Each Cell In ActiveWorkbook.Sheets("RTD_NEWS").Range("D2")
   If Cell = "200" Then

Application.Goto ActiveWorkbook.Sheets("RTD_NEWS").Range("B2", "B61")
Selection.Copy
Worksheets.Add
Application.Goto ActiveSheet.Range("B21")
ActiveCell.PasteSpecial (xlPasteValues)
Application.Wait Now + TimeValue("00:00:06")
   End If
   Next Cell
End Sub