Sub CopieFeuilleEtEnvoiMail()
Dim Fichier As String
Dim iMsg As Object, iConf As Object, iBP As Object
Dim fichierorigine As Workbook
Dim nouveaufichier As Workbook
Const cdoSendUsingPickup = 1
Fichier = 'Enregistrement ' & Format(Date, 'd mmmm yyyy') & '' & Format(Time, 'h mm ss') & '.xls'
Application.ScreenUpdating = False
Set fichierorigine = ThisWorkbook
Set nouveaufichier = Workbooks.Add
fichierorigine.Sheets('Analyse').Cells.Copy 'créer un nouveau classeur contenant uniquement la feuille cible
nouveaufichier.Activate
Range('a1').Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Selection.PasteSpecial Paste:=xlPasteFormats
ActiveWorkbook.SaveAs Filename:=fichierorigine.Path & '\' & Fichier
' enregistrement nouveau classeur (possibilité d'adapter le chemin et le nom du fichier)
ActiveWorkbook.Close 'ferme le classeur enregistré
Application.CutCopyMode = False
'envoi mail
Set iMsg = CreateObject('CDO.Message')
Set iConf = CreateObject('CDO.Configuration')
With iMsg
Set .Configuration = iConf
.To = 'joelle.douvry@laposte.fr' 'destinataire
.Subject = 'Analyse' 'sujet
.HTMLBody = 'Ci joint l'analyse du mois de....' 'corps du message
Set iBP = iMsg.AddAttachment(ThisWorkbook.Path & '\' & Fichier) ' piece jointe
.Send 'envoi
' l'envoi se fait sans message de confirmation et sans copie dans les elements envoyés
End With
Application.ScreenUpdating = True
End Sub