Envoyer un mail séparément à plusieurs destinataires séparement VBA

Bonjour à tous et à toutes,

J'espère que vous allez bien.

Tout d'abord j'ai essayé pas mal de recherches avant d'atterrir sur ce forum et faire ma demande notamment ici : https://forum.excel-pratique.com/excel/envoi-automatique-plusieurs-mails-excel-outlook-147689 mais cela ne réponds pas trop à ma question.

Je m'explique : je possède une liste de mail de 6 personnes (c'est un exemple) avec un montant personnalisé et une adresse pour chacun.

J'aimerai envoyer un mail à l'aide de VBA, séparément, à chaque utilisateur avec leur montant adéquat et leur date de naissance respective.

Cependant, après plusieurs recherches, je ne possède que le code classique ci-dessous:

Function listeMails() As String
    Dim r As Range
    Dim Liste As String

    Set r = Sheets("Destinataires").[A1]
    Liste = r

    Set r = r.Offset(1, 0)

    Do While r <> ""
        Liste = Liste & "; " & r
        Set r = r.Offset(1, 0)
    Loop

    listeMails = Liste
End Function
Sub Mail()

Dim LeMail As Variant

Set LeMail = CreateObject("Outlook.Application")

With LeMail.CreateItem(olMailItem)
    .Subject = "Test mail automatisation"
    .To = listeMails
    .Body = "blablabliblablabla"
    .Display

End With
End Sub

Donc en lançant le code, j'ai ça (vive le .display) :

Sauf que je ne veux pas faire de mail groupés, mais un mail individuel à chacune des personnes mentionnées dans l'exemple du tableau (mail).
Bon, au total j'aurai 60 personnes donc 60 mails individuel avec un corps de texte précis et leur adresse précise.

Je tiens à signaler que je n'ai pour le moment pas besoin de savoir comment mettre un corps de texte personnalisé, j'ai une piste, je désire seulement grossomodo: 6 Display de 6 mails séparement que 1 seul Display content 6 mails groupés..

Je ne sais pas si j'ai été clair, en tout cas je vous souhaite une bonne journée, et merci d'avance :) !

Au lieu de créer une liste de destinataires et à la fin dans le mail, autant mettre les mails directement dans la boucle pour ton besoin non ?

Function Mail() As String
    Dim r As Range, LeMail As Variant, olMailItem As Variant
    Set r = ThisWorkbook.Worksheets("Feuil1").Range("A2")
    Do While r <> ""
        Set LeMail = CreateObject("Outlook.Application")

        With LeMail.CreateItem(olMailItem)
            .Subject = "Test mail automatisation"
            .To = r.Value
            .Body = ThisWorkbook.Worksheets("Feuil1").Cells(r.Row, 5)
            .Display
        End With

        Set r = r.Offset(1, 0)
    Loop
End Function

En espérant t'avoir aidé ;)

Purée mais c'est exactement ça que je cherche à faire, merci beaucoup !!

Mon erreur venait du fait que je n'arrivais pas à créer une boucle !

Merci beaucoup ! :)