VBA: Envoyer un email à un groupe de destinataire en fonct. d'une variable

Bonsoir à tous,

J'ai essayé de créer un bouton VBA qui permet d'envoyer automatiquement un email à un groupe de destinataire en fonction d'une variable (cellule B7).
Si C7 = "A" alors envoyer à tous les destinataires avec un "A" (tableau à droite dans mon exemple en piece jointe), si C7= "B" alorse nvoyer à tous les destinataires avec un "B".

J'ai réussi à créer un bouton qui envoie à une adresse email prédéfinie mais je n'arrive pas à inclure ce type de variable. Je ne sais meme pas si c'est possible....

Si quelqu'un pourrait m'aider ce serait fantastique.

Cordialement,

PS: Ci dessous le "code" que j'ai essayé de faire

Sub Button4_Click()

Dim ObjOutlook As Object

Dim ObjMessage As Object

Dim myItem As Object

Subject = "Sujet du mail"

Set ObjOutlook = CreateObject("Outlook.Application")

Set ObjMessage = ObjOutlook.CreateItem(0)

Set myItem = ObjOutlook.CreateItem(olMailItem)

If ActiveSheet.Range("B7").Value = "A" Or "B" Or "C" Then

myItem.Subject = Subject

Else: myItem.Subject = Subject

End If

If ActiveSheet.Range("B7").Value = "A" Then

ActiveSheet.Range("B3:H12").Select

Selection.Copy

myItem.Bcc =

ElseIf ActiveSheet.Range("B7").Value = "B" Then

ActiveSheet.Range("B3:H12").Select

Selection.Copy

myItem.Bcc =

ElseIf ActiveSheet.Range("B7").Value = "C" Then

ActiveSheet.Range("B3:H12").Select

Selection.Copy

myItem.Bcc =

End If

Set outlookwordeditor = myItem.GetInspector.WordEditor

outlookwordeditor.Range.PasteAndFormat wdFormatOriginalFormatting 

myItem.Display

Set ObjOutlook = Nothing

Application.CutCopyMode = False

ActiveSheet.Range("D1").Select

End Sub

Bonjour BILLYwalsh

Eviter de mettre toutes ces lignes vierges SVP

Voici le code

Constante à mettre au tout début du module

Const wdFormatOriginalFormatting As Integer = 16

Ensuite

Sub Button4_Click()
  Dim Cel As Range
  Dim OutApp As Object, eMail As Object, OutWE As Object
  Dim sDest As String, Sujet As String
  Dim sHTML As String

  Sujet = "Sujet du mail"
  ' Créer la liste des destinataires
  For Each Cel In Range("N4:N8")
    If Cel.Value = Range("B7").Value Then
      sDest = sDest & Cel.Offset(0, 1).Value & "; "
    End If
  Next Cel
  Set OutApp = CreateObject("Outlook.Application")
  Set eMail = OutApp.CreateItem(0)
  With eMail
    .Subject = Sujet
    .BCc = sDest
    .Display
    sHTML = .HTMLBody
    ActiveSheet.Range("B3:H12").Copy
    Set OutWE = eMail.GetInspector.WordEditor
    OutWE.Range.PasteAndFormat Type:=wdFormatOriginalFormatting
    .HTMLBody = .HTMLBody & sHTML
  End With
  Set OutApp = Nothing
  Application.CutCopyMode = False
End Sub

A+

Bonsoir,

Ça marche parfaitement. Merci beaucoup pour votre temps.

Je pensais que votre que le fait de mettre des espaces permettait de rendre le code plus lisible mais ce n'est pas le cas....

Je ne sais pas si c'est de trop mais je me demandais également si il y avait un moyen de garder dans une autre feuille les informations que j'avais rentré; Par exemple, une fois que j'appuie sur la bouton, les informations que j'ai renseigné se "sauvegarde" dans le sheet 2. Avez-vous une idée de comment aborder ce problème afin de garder un historique ?