Bonjour
Merci à ROLAND M pour cette macro qui fonctionne à merveille mais comment la modifier pour qu elle prenne en f1 et f2 l adresse mail plutot que l avoir dans la macro
VOIR CI JOINT partie en couleur
merci d avance
CORDIALEMENT
A+
Sub EnvoiEmail()
Dim NewBook As Workbook, Fich As String, FichTemp As String
'select source et init nom du fich avec date en [A3]
Worksheets("feuil1").Select: Worksheets("feuil1").Activate
Fich = "journée du " & Format(ActiveSheet.Range("A3"), "ddmmyy") & ".xls"
'copy toutes les cellules occupées de cette feuille
ActiveSheet.UsedRange.Copy
'cré NewBook et colle les valeurs avec formats
Set NewBook = Workbooks.Add
NewBook.Sheets(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.FormatConditions.Delete
Application.CutCopyMode = False
NewBook.Sheets(1).Range("A1").Select
'save et load le chemin complet pour suppr après
Application.DisplayAlerts = False
NewBook.SaveAs Filename:=Fich, FileFormat:=xlWorkbookNormal
FichTemp = ActiveWorkbook.FullName
Application.DisplayAlerts = True
'envoi secteur certainement a modifier
ActiveWorkbook.SendMail ("m.m@wanadoo.fr")
ActiveWorkbook.SendMail ("ml.mo@noe.fr ")
'close et supprime le fichier du disque
ActiveWorkbook.Close False
Kill FichTemp
End Sub
Merci à ROLAND M pour cette macro qui fonctionne à merveille mais comment la modifier pour qu elle prenne en f1 et f2 l adresse mail plutot que l avoir dans la macro
VOIR CI JOINT partie en couleur
merci d avance
CORDIALEMENT
A+
Sub EnvoiEmail()
Dim NewBook As Workbook, Fich As String, FichTemp As String
'select source et init nom du fich avec date en [A3]
Worksheets("feuil1").Select: Worksheets("feuil1").Activate
Fich = "journée du " & Format(ActiveSheet.Range("A3"), "ddmmyy") & ".xls"
'copy toutes les cellules occupées de cette feuille
ActiveSheet.UsedRange.Copy
'cré NewBook et colle les valeurs avec formats
Set NewBook = Workbooks.Add
NewBook.Sheets(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.FormatConditions.Delete
Application.CutCopyMode = False
NewBook.Sheets(1).Range("A1").Select
'save et load le chemin complet pour suppr après
Application.DisplayAlerts = False
NewBook.SaveAs Filename:=Fich, FileFormat:=xlWorkbookNormal
FichTemp = ActiveWorkbook.FullName
Application.DisplayAlerts = True
'envoi secteur certainement a modifier
ActiveWorkbook.SendMail ("m.m@wanadoo.fr")
ActiveWorkbook.SendMail ("ml.mo@noe.fr ")
'close et supprime le fichier du disque
ActiveWorkbook.Close False
Kill FichTemp
End Sub