Sub envoi_mail()
Dim PlageTo As Range, PlageCc As Range, Cel As Range, ToutTo$, ToutCc$
Dim plage As Range, derLig As Integer
Sheets("BDD").Select
On Error Resume Next
derLig = Cells(2000, 2).End(xlUp).Row
ActiveSheet.PageSetup.PrintArea = "A1:F" & derLig
On Error GoTo 0
' Affiche le message dans le classeur
ActiveWorkbook.EnvelopeVisible = True
With Sheets("LISTE")
Set PlageTo = .Range("A1:A" & .[A65536].End(2).Row)
Set PlageCc = .Range("A1:A" & .[A65536].End(2).Row)
End With
For Each Cel In PlageTo
If Cel(, 2) = "A" Then ToutTo = ToutTo & ";" & Cel(, 1)
Next
If ToutTo <> "" Then ToutTo = Right(ToutTo, Len(ToutTo) - 1) Else MsgBox "Pas de destinataires": Exit Sub
For Each Cel In PlageCc
If Cel(, 2) = "C" Then ToutCc = ToutCc & ";" & Cel(, 1)
Next
If ToutCc <> "" Then ToutCc = Right(ToutCc, Len(ToutCc) - 1)
With ActiveSheet.MailEnvelope
'"Item" représente un objet Outlook "MailItem".
.Item.To = ToutTo
.Item.CC = ToutCc
.Item.Subject = Range("A1").Value
.Item.display
End With
End Sub