Microsoft 365 Recherche formule pour planning journalier

Private Sub Worksheet_Activate()
Worksheet_Change [A1] 'lance la macro
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim source As Range, jour As Variant, col%, tablo, ncol%, i&, c As Range, j%, deb1, fin1, deb2, fin2, h
If Target.Address <> "$A$1" Then Exit Sub
Set source = Sheets("Feuille 1").[A3:T30]
jour = Application.Match([A1], Array("Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche"), 0)
If IsNumeric(jour) Then col = 2 + 3 * (jour - 1)
Application.ScreenUpdating = False
With [A1].CurrentRegion
    .Offset(1, 1).ClearContents 'RAZ
    If col = 0 Then Exit Sub 'si A1 est vide
    tablo = .Value
    ncol = .Columns.Count
    For i = 2 To .Rows.Count
        Set c = source.Columns(1).Find(.Cells(i, 1), , xlValues, xlWhole)
        If Not c Is Nothing Then
            deb1 = Round(c(1, col), 5): fin1 = Round(c(2, col), 5)
            deb2 = 0: fin2 = 0
            If Weekday(source(1, col), 2) < 7 Then deb2 = Round(c(1, col + 1), 5): fin2 = Round(c(2, col + 1), 5)
            For j = 2 To ncol
                h = Round(tablo(1, j), 5)
                If h >= deb1 And h <= fin1 Or h >= deb2 And h <= fin2 Then tablo(i, j) = "X"
            Next j
        End If
    Next i
    .Value = tablo 'restitution
End With
End Sub

=SIERREUR(REPT("X";OU(ET(h>=xdeb1;h<=xfin1);ET(h>=xdeb2;h<=xfin2)));"")