Autres Idée pour automatiser un fichier de contrôle

Private Sub Worksheet_Activate()
Dim tablo, resu, i&, n&
With Feuil1.UsedRange 'CodeName de la feuille
    tablo = .Resize(, 3) 'matrice, plus rapide
    ReDim resu(1 To 2 * Application.Count(.Columns(1)), 1 To 4)
End With
For i = 1 To UBound(tablo)
    If IsDate(tablo(i, 1)) Then
        If tablo(i + 1, 3) < TimeValue("08:00") Then
            n = n + 1
            resu(n, 1) = tablo(i - 1, 2)
            resu(n, 2) = tablo(i, 1)
            resu(n, 3) = tablo(i + 1, 2)
            resu(n, 4) = tablo(i + 1, 3)
        End If
        If tablo(i + 4, 3) > TimeValue("19:00") Then
            n = n + 1
            resu(n, 1) = tablo(i - 1, 2)
            resu(n, 2) = tablo(i, 1)
            resu(n, 3) = tablo(i + 4, 2)
            resu(n, 4) = tablo(i + 4, 3)
        End If
    End If
Next
With [A3] 'à adapter
    If n Then
        .Resize(n, 4) = resu
        .Resize(n, 4).Sort .Cells(1), xlAscending, .Cells(1, 2), , xlAscending, Header:=xlNo 'tri
        .Resize(n, 4).Borders.Weight = xlThin 'bordures
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 4).Delete xlUp 'RAZ en dessous
End With
End Sub