Envoyer un mail différent à plusieurs destinataires

[gmartinifr]

Bonjour à Tous,

J'ai trouvé plein de chose pour l'envoi d'un mail à plusieurs destinataires, ça m'a permis d'avancer sur mon problème mais là je bloque:
l'idée est d'envoyer un mail contenant un code promo personalisé à chaque destinataire dont les adresses sont contenu dans une colonne (dans la colonne d'a cotés se trouve les codes promo correspondant).
j'ai donc fait une boucle mais ça plante, le systeme va trop vite sans attendre la fin de l'envoi du mail précedent, pour info mon programme "ClickYes" est ouvert en permanence donc je ne l'ai pas intégré à la macro (c'est peut être un problème...vous me direz?)
j'ai bricolé ces quelques lignes trouvées sur le forum...(he oui je suis débutant!)
Merci d'avance pour votre aide!

Sub Message1()
Dim I As Integer, MailTo As String, MailCC As String, MailBCC As String
Dim vPJ, vPJ1, vPJ2, vPJ3, vPJ4, vPJ5, vPJ6, vPJ7, vPJ8, vPJ9, vLigne
Dim OLApplication As Outlook.Application, OLMail As Outlook.MailItem
Set OLApplication = CreateObject("Outlook.Application")
Set OLMail = OLApplication.CreateItem(OLMailItem)

For I = 15 To 20

If Cells(I, 10) = "X" Then
MailTo = MailTo & Cells(I, 9) & ";"
End If

ObjetMessage = Cells(2, 4)
'Récup. message, avec sauts de ligne
For Each vLigne In [F2:F13]
CorpsMessage = CorpsMessage & vLigne & vbLf
Next
vPJ = Range("I3")

With OLMail
.To = MailTo ' Destinataire
.CC = MailCC ' Copie
.BCC = MailBCC ' Invisible
.Importance = olImportanceNormal
.Subject = ObjetMessage ' Sujet
.Body = CorpsMessage ' Message
''''''''''' .Attachments = vPJ 'Pièce jointe
On Error Resume Next


.Categories = "Daily"
'.OriginatorDeliveryReportRequested = True ' Accusé de dépôt
.ReadReceiptRequested = True ' Accusé de lecture
.Display '<<<<<<<<<<<<<Pour voir le mail avant envoi
.Save
.Send '<<<<<<<<<<<<<<<Pour envoyer directement
Application.Wait (Now + TimeValue("0:00:10")) => j'ai tenté ça mais sans résultat!
End With

Next I

End Sub