Макрос: запускать таймер каждый раз в разных ячейках

'--- ЭтаКника ---
 
Private Sub Workbook_Open()
  Set diAdr = CreateObject("scripting.dictionary")
  bt = Now + SEC
  tmr
End Sub
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
  On Error Resume Next
  Application.OnTime bt, "tmr", , False
End Sub
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal T As Range)
Dim a$
  Set T = Intersect(T, Sh.Columns("C"), Sh.UsedRange)
  If T Is Nothing Then Exit Sub
  On Error Resume Next
  Application.EnableEvents = False
  For Each T In T.Cells
    a = "'" & Sh.Name & "'!" & T.Address(0, 0)
    If VarType(T.Value) = vbEmpty Then
      T.Offset(, 5).ClearContents
      diAdr.Remove a
    ElseIf Not diAdr.exists(Sh.CodeName & T.Address(0, 0)) Then
      diAdr(a) = Empty
    End If
  Next
  Application.EnableEvents = True
End Sub
 
'--- Module1 ---
 
Public Const SEC As Date = #12:00:01 AM#
Public bt As Date, StopTimer As Boolean, diAdr As Object
 
Sub tmr()
Dim a
  bt = bt + SEC
  Application.OnTime bt, "tmr"
  On Error Resume Next
  Application.EnableEvents = False
  For Each a In diAdr.keys
    With Range(a).Offset(, 5)
      .Value = .Value + SEC
    End With
  Next
  Application.EnableEvents = True
End Sub

Set T = Intersect(T, Sh.Range("C7:C200"))