Sub test()
Dim c As Integer 'n° ligne'
Dim tm As Date ' heure référence'
Dim dt As String 'date sélectionnée'
Dim dtdpt As String ' date de départ (cellule)'
dt = InputBox('Indiquez la date', 'Date', '01/12/2005')
c = 3000
Do While c >= 1
If CDate(Cells(c, 2)) = DateValue(dt) Then
dtdpt = 'A' & CStr(c)
Do While tm < TimeValue('01:00:00')
If c = 0 Then
MsgBox 'Le tems 01:00:00 n'a pas été dépassé :' & CStr(tm) & ' est atteint en partant de la cellule ' & dtdpt & ' jusqu'à la cellule A1', vbInformation, 'Fini'
Range('A1').Select
Exit Sub
End If
tm = tm + Cells(c, 1)
Cells(c, 1) = TimeValue('00:00:00')
c = c - 1
Loop
MsgBox 'Le temps ' & CStr(tm) & ' est atteint en partant de la cellule ' & dtdpt & ' jusqu'à la cellule A' & CStr(c), vbInformation, 'Fini'
Range('A1').Select
Exit Sub
End If
c = c - 1
Loop