Option Explicit: Option Base 1
Sub Essai()
Dim n&: n = Cells(Rows.Count, 1).End(3).Row: If n = 1 Then Exit Sub
Dim T1, T2, DRC As Date, CPT&, r As Byte, i&, j&, k&
n = n - 1: T1 = [A2].Resize(n, 2): ReDim T2(n, 2): j = 1
Application.ScreenUpdating = 0: Range("A2:B" & n + 1) = Empty
For i = 1 To n
DRC = CDate(T1(i, 1)): r = Minute(DRC) Mod 15
If r = 0 Then
CPT = T1(i, 2): If j > 1 Then k = j - 1: r = -(CPT = T2(k, 2))
If r = 0 Then T2(j, 1) = DRC: T2(j, 2) = CPT: j = j + 1
End If
Next i
[A2].Resize(n, 2) = T2
End Sub