Macro envoi mail + copie cellules

**Orgerox24** · 22/05/2024, 11h49

Bonjour à tous,

Je souhaiterais créer une macro qui me permet d'envoyer un mail un groupe de personnes en reprenant en objet le message "marge au xxx" (date de la veille du mail) et dans le corps du mail :

"Bonjour,

Veuillez trouver ci-dessous la marge au xxx (date de la veille du mail).

[TABLEAUX]

Bonne journée".

La partie qui me pose problème est celle des tableaux. C'est un peu complexe en effet car je souhaiterais que la macro :

- Filtre un tableau d'une feuille sur le nom du responsable
- Sélectionne les cellules visibles du tableau + la ligne juste après (pour tout avoir car le nombre de lignes peut varier)
- Colle ce tableau filtré à la suite du mail.

Et refasse ainsi la même chose sur les autres responsables sachant que certains jours il y'aura tous les reponsables, d'autres un ou deux voire aucun. Il peut donc y avoir 1, 2,3 ou 4 tableaux dans le corps du comme (plus rarement) pas du tout.

J'espère que ma demande est assez claire car ce n'est pas évident à expliquer !

Ci-joint mon code avec la première macro envoi de mail qui fonctionne et la seconde que je voudrais intégrer à la première mais sans savoir comment faire... Je précise que pour cette dernière j'ai copié collé les éléments dans un coin du fichier au lieu du corps du mail comme je voudrais pouvoir le faire.

Merci à tous pour votre aide et bonne journée !

Laura

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
Sub Envoyer_mail()
 
Dim LeMail As Variant
Dim Ligne As Integer
 
Set LeMail = CreateObject("Outlook.application")
 
With LeMail.CreateItem(olMailItem)
    .Subject = Sheets("ListeEmail").Range("A2")
 
    .To = "xxx@xxx; xxx@xxx; xxx@xxx; xxx@xxx; xxx@xxx; xxx@xxx
    .Cc = "xxx@xxx; xxx@xxx; xxx@xxx"
    .Body = Sheets("ListeEmail").Range("B2")
 
    .Display
 
End With
 
End Sub
 
 
Sub Macro_copie()
'
' Macro_copie Macro
'
 
'
    ActiveSheet.ListObjects("Tableau24").Range.AutoFilter Field:=1, Criteria1:= _
        "XXX"
    Range("A2:K40").Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Range("O51").Select
    ActiveSheet.Paste
    ActiveSheet.ListObjects("Tableau24").Range.AutoFilter Field:=1, Criteria1:= _
        "XXX"
    Range("A2:K40").Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("O55").Select
    ActiveSheet.Paste
    Range("B52").Select
    ActiveSheet.ListObjects("Tableau24").Range.AutoFilter Field:=1, Criteria1:= _
        "XXX"
    Range("A2:K40").Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("O58").Select
    ActiveSheet.Paste
    Range("C49:C50").Select
    Range("C50").Activate
    ActiveSheet.ListObjects("Tableau24").Range.AutoFilter Field:=1, Criteria1:= _
        "XXX"
    Range("A2:K40").Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("O61").Select
    ActiveSheet.Paste
    Range("A4").Select
    Application.CutCopyMode = False
    ActiveSheet.ShowAllData
End Sub