XL 2021 Comment lister mardi et mercredi d'une année VBA

If Month(DayToTest) <> Mois Then Place = Place + 1: Mois = Mois + 1

Sub JoursParticuliers()
Const Jours = "23"      ' lun->1; mar->2; mer->3; jeu->4; ven->5; sam->6; dim->7
Const Ici = "b4"        ' première cellule pour l'affichage du résultat
Dim Debut As Date, Fin As Date, i&, leMois&, n&

   With Sheets("Feuil1")
      Debut = Int(.[b1]): Fin = Int(.[b2]): leMois = Month(Debut)
      ReDim t(1 To (Fin - Debut + 1), 1 To 1)
      For i = Debut To Fin
         If InStr(Jours, Weekday(i, vbMonday)) > 0 Then
            If Month(i) <> leMois Then n = n + 1: leMois = Month(i)
            n = n + 1: t(n, 1) = i
         End If
      Next i
      .Range(.Range(Ici), .Cells(Rows.Count, "b")).Clear
      If n > 0 Then .Range(Ici).Resize(n) = t: .Range(Ici).Resize(n).NumberFormat = "ddd * dd mmm yyyy"
   End With
End Sub

Option Explicit

Sub JoursParticuliers()
    Dim tbl(), J&, A&, D#, lig&
    Dim Debut As Date, Fin As Date, i&, leMois&, n&
    ' lun->1; mar->2; mer->3; jeu->4; ven->5; sam->6; dim->7' séparés par un espace
    Const Jours = " 2 3 "
    Const Ici = "b4"        ' première cellule pour l'affichage du résultat
    lig = 365
    With Sheets("Feuil1")
        Debut = Int(.[b1]): Fin = Int(.[b2])
        For J = 0 To 365
            D = CDate(Debut) + J
            If Jours Like "* " & Weekday(D, 2) & " *" Then
            A = A + 1: ReDim Preserve tbl(1 To A): tbl(A) = CLng(D)
            End If
            If D <= (Date - 7) Then lig = A
        Debug.Print lig
        Next
        With .Range(Ici).Resize(UBound(tbl))
            .ClearContents
            .Interior.Color = xlNone
            .Value = Application.Transpose(tbl)
            .NumberFormat = "dddd dd mmmm yyyy"
            .Cells(lig + 1).Interior.Color = vbRed
        End With
    End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i&, mini&, ecart&, lig&
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
Range("A2:A" & Rows.Count).Clear 'RAZ
If Val([A1]) Like "####" Then
    [A2] = DateSerial([A1], 1, 1) '1er janvier
    With [A2:A367]
        .NumberFormat = "ddd dd/mm/yyyy"
        .DataSeries
        If Day(.Cells(.Count)) = 1 Then .Cells(.Count).Delete xlUp
        For i = .Count To 1 Step -1
            If Weekday(.Cells(i)) < 3 Or Weekday(.Cells(i)) > 4 Then .Cells(i).Delete xlUp
        Next i
        For i = .Count To 2 Step -1
            If Month(.Cells(i)) > Month(.Cells(i - 1)) Then .Cells(i).Insert xlDown
        Next i
        mini = 9 ^ 9
        For i = 1 To .Count
            ecart = Abs(.Cells(i) - Date)
            If ecart < mini Then mini = ecart: lig = i
        Next i
        .Cells(lig).Interior.Color = vbCyan
    End With
End If
Application.EnableEvents = True 'réactive les évènements
End Sub