MACRO VBA - ENREGISTRER EN PDF + MAIL -D'UN TABLEAU SPEC

Bonjour,

Apres avoir fais une multitude de Forum, je suis a la recherche d'un code MACRO VBA pour effectuer automatiquement L'enregistrement en PDF et envoi d'email d'un tableau specifiqué dans une feuille. Quelqu'un pourrais m'aider

Julien

Sub Bouton1_Cliquer()

'on crée le fichier PDFdans le même dossier que le fichier source
    Sheets("TA FEUILLE").ExportAsFixedFormat Type:=xlTypexslm, Filename:= _
    ActiveWorkbook.Path & "\" & "NOM DE TON FICHIER.PDF"

     'Envoi d'un message par pièce jointe
     Set outapp = CreateObject("Outlook.Application")

      Dim dest
      Dim outmail As Object, Desti As String
     Dim PJ As String, fich As String

    ' Chemin où se trouvent les fichiers - à modifier
     Const Chemin = "C:\CHEMIN DE TON DOSSIER OU SE TROUVE LE FICHIER\"

     ' Ici, code le destinataire

     dest = "ADRESSE MAIL DES DESTINATAIRES"
     With Sheets("NOM DE TA FEUILLE").Activate
     fich = Dir(Chemin & "*.pdf")
     Do While fich <> ""
         Set outmail = outapp.CreateItem(0)
         With outmail

             .attachments.Add Chemin & fich
        .To = dest
        .Subject = "OBJET DU MAIL"
        .Body = "LE CORPS DU MESSAGE"
        .Display ' a remplacer par .Send si pas de contrôle
         End With
         fich = Dir
     Loop
     'la feuille PDF créée est supprimée après l'envoi
    Kill ActiveWorkbook.Path & "\" & "NOM DU FICHIER CREE.PDF" 'à modifier

    End With
  End With
End sub

Cdlt

Parfait cependant je souhaite enregistrer seulement un tableau sur ma feuille et prédéfinir le nom du fichier par rapport à une celui

Je joint mon fichier excel, je souhaite ajouter la macro sur la feuille ''LISTING'' pour sauvegarder et envoyer par email le tableau de la feuille ''REPORTCOSTJOB'' CELLULE A2 à N18. De plus je veux que le fichier ce nomme par rapport à la cellule le la feuille ''LISTING'' CELLULE B6.

Merci

Sub Bouton1_Cliquer()

Dim cellule As Range
With Sheets("LISTING").Activate
    dossierSauvegarde = "C:\Users\....\Fichiers\" ' Tu crées un dossier avec ton fichier dedans
    nomfichier = Range("B6").Text
   End With
'on crée le fichier PDFdans le même dossier que le fichier source
    Sheets("REPORTCOSTJOB").ExportAsFixedFormat Type:=xlTypexslm, Filename:= _
    ActiveWorkbook.Path & "\" & nomfichier

     'Envoi d'un message par pièce jointe
     Set outapp = CreateObject("Outlook.Application")

      Dim dest
      Dim outmail As Object, Desti As String
     Dim PJ As String, fich As String

    ' Chemin où se trouvent les fichiers - à modifier
     Const Chemin = "C:\Users\.....\Fichiers\" ' Remettre le même chemin où se trouve le fichier 

     ' Ici, code le destinataire

     dest = "........" ' Ici mettre les destinataires
     With Sheets("REPORTCOSTJOB").Activate
     fich = Dir(Chemin & "*.pdf")
     Do While fich <> ""
         Set outmail = outapp.CreateItem(0)
         With outmail

             .attachments.Add Chemin & fich
        .To = dest
        .Subject = "......." ' Ici mettre l'objet du message
        .Body = "......." ' Ici mettre le corps du message

         .Display ' Avec display un contrôle est fait avant l'envoi, si tu ne veux pas de ce contrôle, à remplacer par .Send
         End With
         fich = Dir
     Loop
     Kill ActiveWorkbook.Path & "\" & "*.pdf" ' Là ou détruit le fichier créé 
  End With
End Sub

Cdlt