Envoyer un email à une liste de destinataires cliqués

Bonjour à tous,

J'ai un code qui ouvre un message outlook pour un destinataire sur un bouton. J'aimerais qu'avec un autre bouton pour d'autres destinataires, çà me rajoute le 2éme email dans la même boite outlook, et sans écraser le 1er email.

Merci de votre aide.

 Private Sub envMail_Click()
 Application.ScreenUpdating = False
'envoi d'un mail au depute
    Dim OutApp As Object 'Déclaration de l'application objet Outlook
    Dim OutMail As Object 'Déclaration du mail objet Outlook
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = LCase(Me.pnom.Value) & "." & LCase(Me.nom.Value) & "@" & "assemblee-nationale.fr"
            '.CC =
            .BCC = ""
            .Subject = "Au sujet de..."
           .Body = "Bonjour, " & vbCrLf & "Je voudrais vous faire part..."
            '.Attachments.Add ActiveWorkbook.FullName 'Ajoute en pièce-jointe le classeur actif
            On Error Resume Next
            '.Attachments.Add "E:\Users\\MAJ notes.xlsm" 'Ajouter une pièce-jointe à ton mail, indique le chemin complet au fichier que tu veux attacher
            .display 'affiche le mail en brouillon dans Outlook, pratique pour vérifier avant d'envoyer
            '.Send 'envoie directement le mail
            '.Save 'sauvegarde le mail
        End With
        Set OutMail = Nothing 'nettoie la mémoire en nettoyant les variables
        Set OutApp = Nothing 'nettoie la mémoire en nettoyant les variables
    Application.ScreenUpdating = True
End Sub

Finalement je vais m'inspirer de ce code

Sub Sample()
   'Setting up the Excel variables.
   Dim olApp As Object
   Dim olMailItm As Object
   Dim iCounter As Integer
   Dim Dest As Variant
   Dim SDest As String

   'Create the Outlook application and the empty email.
   Set olApp = CreateObject("Outlook.Application")
   Set olMailItm = olApp.CreateItem(0)

   'Using the email, add multiple recipients, using a list of addresses in column A.
   With olMailItm
       SDest = ""
       For iCounter = 1 To WorksheetFunction.CountA(Columns(1))
           If SDest = "" Then
               SDest = Cells(iCounter, 1).Value
           Else
               SDest = SDest & ";" & Cells(iCounter, 1).Value
           End If
       Next iCounter

    'Do additional formatting on the BCC and Subject lines, add the body text from the spreadsheet, and send.
       .BCC = SDest
       .Subject = "FYI"
       .Body = ActiveSheet.TextBoxes(1).Text
       .Send
   End With

   'Clean up the Outlook application.
   Set olMailItm = Nothing
   Set olApp = Nothing
End Sub

pour créer une liste d'emails que j'ajouterais quand la liste sera compléte. Comme çà :