Macro excel pour envoyer mail avec insertion

J'ai développé le code ci-après pour envoyer à plusieurs destinataires un fichier Excel d'adhérents à une association - auquel de nouveaux sont donc régulièrement ajoutés - après l'avoir "sorted", puis enlevé d'éventuels doubles, redéfini la zone à imprimer, sauvegardé à différents endroits avec un nom mis à jour en fonction de l'ordinateur sur lequel l'application tourne:
Sub Kopier_naar_Mijn_gegevensbronnen()
' afdruk_bereik Macro
' De macro is opgenomen op 12/03/2008 door Erik.
'
Dim OldFn As String, ShortFn As String, NewFn As String, DirDest1 As String, DirDest2 As String
Dim RowNumber As Integer
Dim MailAd As Variant
'
' Cachez l'écran
Application.DisplayAlerts = False
' Sort
Range("N2").Select
Selection.End(xlDown).Select
RowNumber = ActiveCell.Row
RRange = "A2:BA" & RowNumber & ""
Range(RRange).Sort Key1:=Range("N2"), Order1:=xlAscending, Key2:=Range _
("O2"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase _
:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
'
' Cherchez doubles
n = 957 '2
While Range("N" & n) <> ""
Range("N" & n).Select
If (LCase(Range("N" & n) & Range("O" & n)) = LCase(Range("N" & n - 1) & Range("O" & n - 1))) Or (Range("V" & n) <> "" And LCase(Range("V" & n)) = LCase(Range("V" & n - 1))) Then
RowNumber = ActiveCell.Row
RRange = "N" & RowNumber & ""
Range(RRange).Select
MsgBox "Un double est à éliminer à la rangée " & RowNumber & "."
Stop
End If
n = n + 1
Wend
'
' Sélectionnez printarea
Range("N2").Select
Selection.End(xlDown).Select
RowNumber = ActiveCell.Row
Range("AG" & RowNumber).Select
Range(Selection, Selection.End(xlUp)).Select
Range(Selection, Selection.End(xlToRight)).Select
ActiveSheet.PageSetup.PrintArea = "$AG$1:$AL$" & RowNumber
Range("N2").Select
'
' Kopier ongedateerd naar "Mijn Gegevensbronnen"
OldFn = ActiveWorkbook.Name
ShortFn = Left(OldFn, Len(OldFn) - 11) & ".xls"
NewFn = Left(ShortFn, Len(ShortFn) - 4) & "_" & Format(Date, "yymmdd") & ".xls"
' MsgBox "L'ancien fichier s'appelait " & oldfn & ", la racine en est " & shortfn & " et le nouveau fichier s'appellera " & newfn

' MsgBox "L'ordinateur s'appelle " & Application.UserName & "."
If Application.UserName = "Erik" Then
DirDest1 = "C:\Documents and Settings\Erik\Mes documents\Mijn gegevensbronnen\"
DirDest2 = "C:\Documents and Settings\Erik\Mes documents\Orgues\Adhérents\"
MailAd = Array("hhh@club-internet.fr", "ccc@neuf.fr")
End If
If Application.UserName = "Hilde Pernet" Then
DirDest1 = "C:\Documents and Settings\HP\Mes documents\Mijn gegevensbronnen\"
DirDest2 = "C:\Documents and Settings\HP\Mes documents\Orgues\Adhérents\"
MailAd = Array("eee@club-internet.fr", "ccc@neuf.fr")
End If
If Application.UserName = "Claude" Then
DirDest1 = "C:\Documents and Settings\Claude\Mes documents\Mes sources de données\"
DirDest2 = "C:\Documents and Settings\Claude\Mes documents\Orgues\Adhérents\"
MailAd = Array("eee@club-internet.fr", "hhh@club-internet.fr")
End If

' Copier le fichier à DirDest1 et DirDest2

' MsgBox "Le fichier " & ShortFn & " sera bientôt enregistré sur " & DirDest1 & "."
On Error Resume Next: MkDir DirDest1
On Error Resume Next: ActiveWorkbook.SaveAs Filename:=DirDest1 & ShortFn, ReadOnlyRecommended:=True
On Error Resume Next: MkDir DirDest2
On Error Resume Next: ActiveWorkbook.SaveAs Filename:=DirDest2 & NewFn, ReadOnlyRecommended:=False, AddToMru:=True

Application.DisplayAlerts = True

' Envois par courriel
On Error Resume Next
' MsgBox "Le fichier " & newfn & " sera bientôt envoyé au Président, à la Secrétaire et au Trésorier." & vbCrLf & "Effacez dans la liste des destinataires votre propre adresse."
Application.Dialogs(xlDialogSendMail).Show MailAd
'
End Sub

Bonsoir

Je suis pas trés douée en informatique, le minimum ...
Concernant un mail sous outloouk, je peux mettre en piece jointe un texte word ou une photo, mais j'ai du essayer l'envoie d'un fichier excel et spécialement 1 page et la horreur je n'ai rien pu faire!!!!

SVP aidez moi!!!merci.