Macro envoie mail multiple

Bonjour,

J'ai besoin de vos lumières pour une macro afin d'envoyer plusieurs éléments dans un onglet.

Sur la feuille Stats indiv j'aimerais faire une macro qui puisse envoyé automatiquement à chaque personne du tableau avec son graphique associé.

J'ai une macro qui me permet d'envoyé le premier tableau.

Je ne maitrise pas les boucles donc si une ame charitable pouvait m'aider

Merci d'avance

Bonjour,

Voici un essai, vous aurez au moins le principe pour la boucle :

Private Sub CommandButton1_Click()

Dim OL As Object, mail As Object, wDoc As Object, rng As Object
Dim wsIndiv as worksheet, wsConfig as worksheet
Dim zonecopie as range
Dim title$, email$, filedate$, n$

Set wsIndiv = Sheets("Stats indiv")
Set wsConfig = Sheets("config")
Set OL = CreateObject("Outlook.Application")

filedate = Format(wsConfig.Range("C2").value, "DD/MM/YY") 'date en config

for i = 1 to 5 'pour i allant de 1 à 5
    j = 5 + (i - 1) * 33 'j = 5 si i vaut 1, 38 si i vaut 2, ...
    with wsIndiv 'sur feuille indiv
        email = .cells(j, 8).value '<<<<< ADAPTER : colonne 8 fictive, car pas d'adresse mail ???
        title = "Stats : " & .Cells(j, 1).Value & " pour la journée du " & filedate
        set zonecopie = .range("A" & j - 2 & ":H" & j + 28)
    end with
    Set mail = OL.CreateItem(olMailItem)
    Set wDoc = mail.GetInspector.WordEditor
    With mail
        .To = email
        .Subject = title
        .BodyFormat = olFormatHTML
        .Display
        zonecopie.Copy
        Set rng = wDoc.Content
        rng.Paste
    End With
    Set zonecopie = Nothing
    Set mail = Nothing
    Set wDoc = Nothing
next i

Set OL = Nothing

End Sub

Je n'ai vu d'endroit réservé à l'adresse mail. Est-ce que ça marchait avec votre code ?

Cdlt,

Merci 3GB pour ce code.

En revanche j'ai une erreur d'exécution 438 sur:

Set wDoc = mail.GetInspector.WordEditorL

Concernant les adresses mail c'est toujours en rapport avec la même cellule du tableau donc j'ai mis :

email = .cells(j, 1).value

Ça, c'est une partie du code que je ne maitrise pas et qui provient de votre code...

J'aurais mis WordEditor pour voir mais je ne peux pas grand-chose de plus, je n'ai même pas outlook.

Oui, j'ai compris que c'était la cellule "Mr A" par exemple quand i = 1. Mais je ne vois pas comment le mail pourrait partir puisqu'il n'y a pas d'adresse mail dans cette cellule. D'où ma question.

Du coup j'ai modifié et cela fonctionne nickel ,il y avait un L en plus sur :

Set wDoc = mail.GetInspector.WordEditorL

Merci

En revanche comme je serais amené à ajouter des tableau je voudrais que cela s'arrête à la première cellule vide après le dernier tableau.

J'ai essayé en ajoutant

For i=1to Range("A65536").End(xlUp).row
avec un If ActiveCell.Value<>"" then
Le code.....
Else
Selection.Offset(1,0).select

Mais cela ne fonctionne pas j'ai une erreur de compilation Next sans For.

Avez vous une idée? Merci

Bonjour,

Quand vous ajouterez des tableaux, soyez bien vigilant à respecter le même modèle, à savoir un tableau 33 lignes après le précédent. Sinon, ça ne marchera pas...

Et justement, la boucle porte sur le nombre de tableaux et non le nombre de lignes. C'est pourquoi je pencherais plus vers une autre solution : trouver en colonne A une valeur commune à chaque tableau et faire ainsi :

Dim nbtab%

'....le code

nbtab = application.countif(Range("A:A"), "valeurcommune") '<<<< modifier par la vraie valeur commune
for i = 1 to nbtab
....
next

Sinon, ici, je ne vois pas votre code en entier mais ce qui est sûr, c'est qu'il manque le end if ou le next...

Bonjour 3GB,

Désolé pour le retour tardif.

J'ai du coup changer le nombre de tableau dans un premier temps afin de pouvoir envoyer quelque chose rapidement.

Merci pour le temps que vous m'avez consacré