Envoi mail automatique via Excel

Bonjour à tous,

J'ai crée un fichier avec un plusieurs onglets. j'aimerai envoyer chaque onglet un par un et non le fichier en entier via une macro.

Malheureusement avec la macro que j'ai écrite (ci-dessous) c'est systématiquement le fichier complet qui est envoyé.

Quelqu'un aurait une solution?

Sub SendEmail()

' SendEmail Macro

'

'

Dim olApp As Outlook.Application

Set olApp = CreateObject("outlook.application")

Dim olMail As Outlook.MailItem

Set olMail = olApp.CreateItem(olMailItem)

With olMail

.To = "............."

.Subject = " détail frais comptabilisés_67218 "

.Body = Range("I2").Value & vbCrLf & vbCrLf & Range("I3").Value & vbCrLf & vbCrLf _

& Range("I4").Value & vbCrLf & vbCrLf & Range("I6").Value & vbCrLf & Range("I7").Value & Range("I8").Value & vbCrLf _

& Range("I9").Value & vbCrLf & Range("I10").Value & vbCrLf & Range("I11").Value & vbCrLf & Range("I12").Value & vbCrLf _

& Range("I13").Value & vbCrLf

.Attachments.Add "O:\CGIE\COMMUN\9202633M (Mouth céline)\2019\NDF\Frais comptabilisés UP\02 Frais comptabilisés - Concur_détail UP.xlsx"

.Send

End With

End Sub[/Surligner][/Inline][/Inline]

Bonjour,

voici un exemple,

Sub SendEmail()
Dim olApp As Outlook.Application
Dim olMail As Outlook.MailItem

Set olApp = CreateObject("outlook.application")
Set olMail = olApp.CreateItem(olMailItem)

For Each Sh In ThisWorkbook.Worksheets
    Sh.Copy
    fichier = "c:\Temp\" & Sh.Name & ".xls"
    ActiveWorkbook.SaveAs fichier
    ActiveWorkbook.Close False

    With olMail
        .To = "............."
        .Subject = " détail frais comptabilisés_67218 "
        .Body = Range("I2").Value & vbCrLf & vbCrLf & Range("I3").Value & vbCrLf & vbCrLf _
        & Range("I4").Value & vbCrLf & vbCrLf & Range("I6").Value & vbCrLf & Range("I7").Value & Range("I8").Value & vbCrLf _
        & Range("I9").Value & vbCrLf & Range("I10").Value & vbCrLf & Range("I11").Value & vbCrLf & Range("I12").Value & vbCrLf _
        & Range("I13").Value & vbCrLf
        .Attachments.Add fichier
        .Send
    End With
Next Sh
End Sub