Envoie de mail à plusieurs destinataires sur condition

Bonjour à tous, J'ai un petit soucis depuis 2-3 jours que je n'arrive pas à régler donc j'ai décider de venir vous demandez de l'aide.

Je m'explique, tout d'abord j'ai un lourd tableau d'excel qui contient des noms, des mails , des dates, etc et je doit lorsque 1 élèves à sa date de péremption de Titre de séjour qui arrive , ma macro affiche une Alerte à l'écran puis récupère le mail de cette élève qui est dans le Tableau après envoie un mail d'alerte en passant par outlook.

J'ai réussi à faire tout cela mais le problème est quand il y a plusieurs date de péremption qui arrive de plusieurs élèves ma macro n'envoient qu'au premier élève et autre élève il ne l'envoie pas. Que dois-je faire pour qu'il envoie à tous les élèves qui remplissent la condition ?

Mon code est le suivant :

Private Sub Workbook_Open()

Dim olApp As Outlook.Application 'création de ma variable olApp'
Set olApp = CreateObject("outlook.application") 'Création de l'objet "outlook.application" à partir de outlook'
Dim Body As Variant

        Dim olMail As Outlook.MailItem 'Création de ma variable olMail'
        Set olMail = olApp.CreateItem(olMailItem) 'Attribution d'une référence d'objet à la variable olMail'

        With olMail
        'On Error Resume Next
        .CC = "leroymarc179@outlook.fr" 'Adresse mail de l'envoyeur'

If (Range("Y3").Value - Date <= 75) Then 'Si la valeur qu'il y a dans la colonne "Y" ligne "3" moins la Date du jour'
'est inférieur ou égale à 75'

     Range("Y3").Font.ColorIndex = 3
     Body = Range("E3").Value 'Body s'attribue la valeur entrée dans E3'
    .To = Body '.To s'attribue la valeur de Body qui est l'adresse mail auquel le mail est envoyé'
    .Subject = "Alert title of stay shortly invalid" 'Sujet du mail "Alert title of stay shortly invalid" + "La date du jour "'
    .Body = Range("A3").Value & vbCrLf & Range("B3").Value & Range("C3").Value & vbCrLf & vbCrLf _
    & Range("A150").Value & vbCrLf & vbCrLf _
    'le fichier comportant la macro devrait avoir les données du corps du mail dans les cellules A1...A4
    .Attachments.Add "xxxxx"
    'Créer une pièce jointe dans l'addresse mail dont le fichier est "xxxx'
    'depuis le chemin d'accès "xxx"'

    MsgBox "Péremption prochaine du titre de séjour,un mail a été envoyer à : " & Range("A3") & Range("B3") & Range("C3") 'Une alerte affiche à l'écran "Un mail a été envoyer à un de vos élèves"'

   .send

Else 'Sinon '
    Range("Y3").Font.ColorIndex = 10
    'MsgBox "Tout est Ok" 'Une alerte affiche à l'écran "Tout est Ok"'

End If 'Fin de la fonction Si'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 If (Range("Y4").Value - Date <= 75) Then 'Si la valeur qu'il y a dans la colonne "Y" ligne "3" moins la Date du jour'
'est inférieur ou égale à 75'

    Range("Y4").Font.ColorIndex = 3
    Body = Range("E4").Value 'Body s'attribue la valeur entrée dans E4'
    .To = Body '.To s'attribue la valeur de Body qui est l'adresse mail auquel le mail est envoyé'
    .Subject = "Alert title of stay shortly invalid" 'Sujet du mail "Alert title of stay shortly invalid" + "La date du jour "'
    .Body = Range("A4").Value & vbCrLf & Range("B4").Value & vbCrLf & vbCrLf _
    & Range("C4").Value & vbCrLf & vbCrLf _
    'le fichier comportant la macro devrait avoir les données du corps du mail dans les cellules A1...A4
    .Attachments.Add "xxx"
    'Créer une pièce jointe dans l'addresse mail dont le fichier est "xxx" accessible'
    'depuis le chemin d'accès "xxxx"'

     MsgBox "Péremption prochaine du titre de séjour,un mail a été envoyer à l'élève A4 " 'Une alerte affiche à l'écran "Un mail a été envoyer à un de vos élèves"'

    .send

Else 'Sinon'
    Range("Y4").Font.ColorIndex = 10
    'MsgBox "Tout est Ok" 'Une alerte affiche à l'écran "Tout est Ok"'

End If 'Fin de la fonction Si'

End With

End Sub

Merci d'avance pour votre réponse