Il y a surement de quoi s'inspirer
mais comme c'est le week-end
je vous laisse
Sub Mail_sheets()
'http://www.exceltip.com/st/Mail_sheet(s)_to_one_or_more_people_using_VBA_in_Microsoft_Excel/542.html
Dim MyArr As Variant
Dim last As Long
Dim shname As Long
Dim a As Integer
Dim Arr() As String
Dim N As Integer
Dim strdate As String
For a = 1 To 253 Step 3
If ThisWorkbook.Sheets('mail').Cells(1, a).Value = '' Then Exit Sub
Application.ScreenUpdating = False
last = ThisWorkbook.Sheets('mail').Cells(Rows.Count, a).End(xlUp).Row
N = 0
For shname = 1 To last
N = N + 1
ReDim Preserve Arr(1 To N)
Arr(N) = ThisWorkbook.Sheets('mail').Cells(shname, a).Value
Next shname
ThisWorkbook.Worksheets(Arr).Copy
strdate = Format(Date, 'dd-mm-yy') & ' ' & Format(Time, 'h-mm-ss')
ActiveWorkbook.SaveAs 'Part of ' & ThisWorkbook.Name _
& ' ' & strdate & '.xls'
With ThisWorkbook.Sheets('mail')
MyArr = .Range(.Cells(1, a + 1), .Cells(Rows.Count, a + 1).End(xlUp))
End With
ActiveWorkbook.SendMail MyArr, ThisWorkbook.Sheets('mail').Cells(1, a + 2).Value
ActiveWorkbook.ChangeFileAccess xlReadOnly
Kill ActiveWorkbook.FullName
ActiveWorkbook.Close False
Application.ScreenUpdating = True
Next a
End Sub