4 For ...Next imbriqués : code à optimiser

Sub Cibler_les_Absents1()
Dim c1 As Range, LaDate As Long, idx As Variant, feuille As Worksheet
Dim Absence As String, c As Range, n As Byte, m As Byte, p As Byte, i As Byte, trouve As Boolean
Application.ScreenUpdating = False
Set feuille = Sheets("Feuil1")
For Each c1 In Range("B4:AB4")
  If c1 <> "" Then
    LaDate = CLng([c1])
    idx = Application.Match(LaDate, Range("B4:AB4"), 0)
    rng = Array("Claudine", "Guillaume", "Sandra", "Valérie", "Jean-Luc", "Stéphanie", "Bruno")
    Set c = feuille.Range("B4:AB4").Cells(idx, idx)
    If Not c Is Nothing Then
      For n = 27 To feuille.Cells(34, c.Column).End(xlUp).Row
        trouve = False: Absence = ""
        If feuille.Cells(n, c.Column) <> "" Then
          For p = LBound(rng) To UBound(rng)
            If feuille.Cells(n, c.Column) = rng(p) Then
              Absence = rng(p)
              For m = 5 To feuille.Cells(19, c.Column).End(xlUp).Row
                If feuille.Cells(m, c.Column) = Absence Then
                  trouve = True
                  
                 'Mise en forme et placement de la Shape "Absent"
                  .../...                 
                 ' Fin de la création de la Shape "Absent"
                 
                End If
                If trouve = True Then Exit For
              Next m
            End If
            If trouve = True Then Exit For
          Next p
        End If
      Next n
    End If
  End If
Next
Range("A1").Select
Application.ScreenUpdating = True
End Sub