Macro pour créer un fichier provisoire et envoyer par mail

Bonjour à tous,

je souhaiterait créer une marco qui puisse créer un fichier à joindre dans Outlook qui reprennent pour l'ensemble des lignes de la feuille "suivi des antériorités" qui ont la même valeur dans la colonne AB, les colonnes à en-tête verte.
La macro créerais autant de mail avec un tableau qu'il y a de valeur dans la colonne AB
Le mail serait créé avec pour adresse mail, le mail indiqué en colonne H de la feuille "Base CL" pour la valeur dans le suivi des antériorités en colonne B, correspondante dans la colonne A de l'onglet base CL
Le mail aurait comme texte : Bonjour voici vos relances
et comme objet : relance

Je suis très novice et j'ai à peine réussi à écrire une macro pour ouvrir excel ...

Par avance merci pour votre aide !!!

Salut RachelB et le Forum,

le résultat que tu souhaites n'est pas vraiment à la portée d'un débutant, j'ai trouvé ça au fond d'un tiroir

Sub CreateEmailsExcel()
'https://forum.excel-pratique.com/excel/macro-pour-creer-un-fichier-provisoire-et-envoyer-par-mail-195528

    Dim targetWorkbook As Workbook
    Dim objFSO      As Object
    Dim varTempFolder As Variant, v As Variant
    Dim OutApp      As Object, OutMail As Object, rng As Range, i As Long, LastRow As Integer
    Dim AttFile     As String, Dest As String
    Dim WsBase As Worksheet

    Set OutApp = CreateObject("Outlook.Application")
    Application.ScreenUpdating = False

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    varTempFolder = objFSO.GetSpecialFolder(2).Path & "\Temp " & Format(Now, "dd-mm-yyyy- hh-mm-ss")
    objFSO.CreateFolder (varTempFolder)

    Sheets("Suivi des antériorités").Activate
    v = Range("A2").CurrentRegion.Value

    With CreateObject("scripting.dictionary")
        For i = 2 To UBound(v)
            If Not .exists(v(i, 28)) Then
                .Add v(i, 28), Nothing
                With ActiveSheet
                    .Range("A1").AutoFilter 28, v(i, 28)
                    Set rng = .AutoFilter.Range
                    Set targetWorkbook = Workbooks.Add
                    .UsedRange.SpecialCells(xlCellTypeVisible).Copy targetWorkbook.Worksheets(Sheets.Count).Range("A1")
                    AttFile = v(i, 28) & ".xlsx"

                Set WsBase = ThisWorkbook.Sheets("Base CL")
                LastRow = WsBase.Cells(WsBase.Rows.Count, "G").End(xlUp).Row
                Dest = Application.WorksheetFunction.VLookup(v(i, 28), WsBase.Range("G2:H" & LastRow), 2, False)

                    With targetWorkbook
                        .ActiveSheet.Columns.AutoFit
                        .ActiveSheet.Range("D:D, F:I, M:N, Q:R, Y:Y, AA:AB").Delete
                        .SaveAs varTempFolder & "\" & AttFile
                        .Close
                    End With

                    Set OutMail = OutApp.CreateItem(0)
                    With OutMail
                        .To = Dest
                        .Subject = "relance"
                        .HTMLBody = "Bonjour voici vos relances"
                        .Attachments.Add varTempFolder & "\" & AttFile
                        .Display
                        ' .Send
                    End With
                End With
            End If
        Next i
    End With
    Range("A1").AutoFilter

    With objFSO
        .deletefile varTempFolder & "\*.*", True
        .DeleteFolder varTempFolder
    End With

    Application.ScreenUpdating = True
End Sub

Cordialement

Bonjour, merci pour ce retour je vais tester lundi sur PC et vous ferais un retour !!!

Bon week end à vous !

Bonjour @Sequoyah,

grandement merci ! J'ai pu réadapter cette macro sur le fichier initial et cela fonctionne parfaitement ! A la lecture du code, effectivement je n'aurais jamais réussi à la créer toute seule !!

Je vais clôturer la publication et encore merci à vous !