Sub envoimailtutoiement()
Dim OlApp As Object, OlMail As Object
Dim Adr1$, Chemin$, Fichier$, Nom$, Rep_Xlsx
Chemin = ThisWorkbook.Path & "\"
Nom = ActiveSheet.Name
adr = ActiveSheet.Range("a1").Value
ActiveSheet.Copy
Application.DisplayAlerts = False
ActiveSheet.SaveAs Filename:=Chemin & Nom & ".xlsx"
ActiveWorkbook.Close True
Set OlApp = CreateObject("Outlook.Application")
Set OlMail = OlApp.CreateItem(0)
Fichier = ThisWorkbook.Path & "\" & Nom & ".xlsx"
With OlMail
.To = adr 'Envoyer à
.Subject = "FACTURES " 'Sujet
.Body = "Bonjour," 'Corps du message
.Attachments.Add Fichier 'Fichier en pièce jointe
.Display
'.Send 'Envoi direct
End With
'OlApp.Quit
Set OlMail = Nothing
Set OlApp = Nothing
Rep_Xlsx = Dir(Chemin & "*.xlsx")
Do While Rep_Xlsx <> ""
Kill Chemin & Rep_Xlsx
Rep_Xlsx = Dir
Loop
End Sub