XL 2019 Gérer la descente d'une cellule colorer selon un timer

Sub DescenteCellule()
    Dim vitesse As Double
    Dim delai As Double
    Dim i As Integer, j As Double
    Dim couleur As Long

    If IsNumeric(Range("A1").Value) Then
        vitesse = Range("A1").Value
        If vitesse <= 0 Then
            MsgBox "La valeur de A1 doit être supérieure à 0.", vbExclamation
            Exit Sub
        End If
    Else
        MsgBox "Veuillez entrer un nombre valide dans la cellule A1.", vbExclamation
        Exit Sub
    End If
   
    'delai = 1 / (1 + (vitesse - 1) * 0.2)
    couleur = Range("D5").Interior.Color
    Range("D5:D25").Interior.ColorIndex = xlNone

    For i = 5 To 25
        Range("D5:D25").Interior.ColorIndex = xlNone
        Range("D" & i).Interior.Color = couleur
        DoEvents
        'Application.Wait Now + TimeSerial(0, 0, delai)
        For j = 1 To Int(10000000 / vitesse)
        Next j
    Next i

    Range("D25").Interior.ColorIndex = xlNone
    Range("D5").Interior.Color = RGB(0, 255, 0) ' Vert
End Sub

Option Explicit
                        #If VBA7 Then
Private Declare PtrSafe Function QueryPerformanceFrequency Lib "kernel32" (X As Currency) As Boolean
Private Declare PtrSafe Function QueryPerformanceCounter Lib "kernel32" (X As Currency) As Boolean
                        #Else
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (X As Currency) As Boolean
Private Declare Function QueryPerformanceCounter Lib "kernel32" (X As Currency) As Boolean
                           #End If
Sub Attendre(ByVal DuréeSec As Double)
   Static CtrPré As Currency
   Dim CtrAct As Currency, Fréq As Currency
   If CtrPré = 0 Then QueryPerformanceCounter CtrPré
   QueryPerformanceFrequency Fréq
   Do: QueryPerformanceCounter CtrAct
      If (CtrAct - CtrPré) / Fréq >= DuréeSec Then Exit Do
      DoEvents: Loop
   CtrPré = CtrPré + DuréeSec * Fréq
   End Sub

#If VBA7 Then
    Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Sub Tempo(t)
  Dim x As Integer
  For x = 0 To t - 1
    Sleep 100: DoEvents
  Next x
End Sub

Sub DescenteCellule()
    Dim vitesse As Double, delai As Double, couleur As Long, i As Integer, t As Double
    
    vitesse = Int(Val(Range("A1")))
    Range("A1") = vitesse
    If vitesse <= 0 Then MsgBox "La valeur de A1 doit être supérieure à 0.", vbExclamation:  Exit Sub
    delai = 1 / (1 + (vitesse - 1) * 0.2)
    couleur = Range("D5").Interior.Color

    For i = 5 To 25
        t = Timer + delai
        While Timer < t And t < 86400: DoEvents: Wend
        Range("D" & i - 1).Interior.ColorIndex = xlNone
        Range("D" & i).Interior.Color = couleur
    Next i

    Range("D25").Interior.ColorIndex = xlNone
    Range("D5").Interior.Color = RGB(0, 255, 0) ' Vert
End Sub

Option Explicit
Dim Coeff#

Sub DescenteCellule()
Const Empirique = 1.4                                 ' correction empirique au doigt mouillé
Dim couleur&, i&, k&, kfin#, debut, x
   If Coeff = 0 Then Coeff = calibrage                ' calibrage si coeff est égal à zéro
   [k2] = ""
   couleur = couleurD5                                ' une couleur au hasard
   [d5:d25].Interior.ColorIndex = xlColorIndexNone    ' plage sans couleur de fond
   kfin = [a1] / 1000 * Coeff / Empirique             ' nombre de "DoEvents" entre 2 déplacements
   debut = Timer
   [D5].Interior.Color = couleur                      ' couleur de fond de la cellule de départ
   For i = 1 To [d5:d25].Rows.Count - 1               ' boucle sur la plage
       For k = 1 To kfin: DoEvents: Next              ' tempo
       [D5].Offset(i - 1).Interior.ColorIndex = xlColorIndexNone  ' effacement du fond de la cellule colorée
       [D5].Offset(i).Interior.Color = couleur                    ' couleur de fond de la cellule à colorer
   Next i
   [k2] = 1000# * (Timer - debut)         ' calcul de la durée total (approximatif)
   [a1].Select                            ' sélection de la prochaine vitesse
End Sub

Function calibrage() As Double
Dim tdeb#, tfin#, n#
   tfin = Time + (1# / 86400)                         ' heure de fin (correspond à une seconde)
   Do: n = n + 1: DoEvents: Loop Until Time > tfin    ' comptage des "DoEvents" en une seconde
   calibrage = n                                      ' retour du calibrage (/ 2 = ajustement pifométrique)
End Function

Function couleurD5()    ' déterminer une couleur au hasard
   Randomize
   couleurD5 = RGB(1 + Rnd * 255, 1 + Rnd * 255, 1 + Rnd * 255)
End Function