Macro envoi fichier différent par mail à des gens différents

Bonjour à toutes et tous,

Alors voilà je sèche un peu sur une macro.

Le contexte :

  • Fichier national
  • Découpe en régional basé sur la valeur d'une colonne
  • Envoi par mail à chaque représentant régional de sa version régionale

Etat à date :

  • Découpe régionale avec un fichier par région de créé avec un nom adapté : Fichier_Région 1.xlsx ; etc.
  • Envoi par mail possible de tous les fichiers à une personne mais pas à chacune des personnes

Mon hypothèse serait une macro qui fasse une recherche par le nom du fichier et si elle trouve dans le nom Région 1, alors elle l’envoi au représentant de la région 1 mais je ne sais pas comment la coder.

Code actuel :

Sub Split()

Dim i As Long, iMin As Long, iMax As Long, tcd As Integer
Dim File As String, nFile As String, Dest As String, Sujet As String

    'Explications à l'utilisateur ; s'il cliquer sur Annuler on abandonne
    i = MsgBox("Cette macro va vous demander d'ouvrir le fichier Flash DR avec les données France, puis va créer un fichier pour " & _
                "chaque DR. Chacun d'eux sera enregistré dans le même dossier que le fichier France." & Chr(13) & _
                "Cliquer sur OK pour continuer ou sur Annuler pour abandonner", vbOKCancel, "Découpage du Flash par Région")
    If i = 2 Then End
    'On demande à l'utilisateur d'ouvrir le fichier Flash France
    i = Application.Dialogs(xlDialogOpen).Show

    'si l'utilisateur clique sur Annuler, on arrête tout, sinon on récupère le nom du fichier
    If i = 0 Then
        End
    Else
        File = ActiveWorkbook.Name
    End If

    ActiveWorkbook.Sheets(14).Activate
    iMin = 2                            'N° de ligne de départ (change dynamiquement au cours du process)
    iMax = Cells(2, 1).End(xlDown).Row  'Nombre total de lignes du fichier

    'on entame le traitement...
    Do

    'On affiche le fichier France, si pas trouvé on l'ouvre de nouveau
    For i = 1 To Workbooks.Count
        If Workbooks(i).Name = File Then Workbooks(i).Activate: Exit For
    Next i
    If ActiveWorkbook.Name <> File Then Workbooks.Open Filename:=File, UpdateLinks:=False
    ActiveWorkbook.Sheets(14).Activate

        'On recherche la dernière ligne du même secteur
        For i = iMin To iMax
            If Cells(i, 1) <> Cells(i + 1, 1) Then Exit For
        Next i

        'On supprime les lignes des autres secteurs
        If i < iMax Then Rows(i + 1 & ":" & iMax).Delete
        If iMin > 2 Then Rows("2:" & iMin - 1).Delete
        iMin = i + 1
        'Régions: nFile = Left(File, Len(File) - 5) & " R" & Mid(Cells(i, 2), 2, Len(Cells(i, 2)) - 2) & ".xlsx"

        'Nom du fichier pour le secteur
        nFile = Left(File, Len(File) - 4) & "" & Cells(2, 1) & ".xlsx" '" R" & Mid(Cells(2, 1), 2, Len(Cells(2, 1)) - 2) &

        'On rafraichit les TCD, on sauvegarde et on ferme le fichier
        ActiveWorkbook.Sheets(1).Activate

        'ActiveWorkbook.ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotCache.Refresh
        With ActiveWorkbook.ActiveSheet
            For tcd = 1 To .PivotTables.Count
                .PivotTables(tcd).PivotCache.Refresh
            Next tcd
        End With

        ActiveWorkbook.Sheets(2).Activate
                With ActiveWorkbook.ActiveSheet
            For tcd2 = 1 To .PivotTables.Count
                .PivotTables(tcd2).PivotCache.Refresh
            Next tcd2
        End With

        ActiveWorkbook.Sheets(4).Activate
                With ActiveWorkbook.ActiveSheet
            For tcd4 = 1 To .PivotTables.Count
                .PivotTables(tcd4).PivotCache.Refresh
            Next tcd4
        End With

        ActiveWorkbook.Sheets(14).Activate
        ActiveWorkbook.SaveAs Filename:=nFile, Password:=""
        Dest = "floh@floh.com"
        Sujet = "Envoi données régionales"
        ActiveWorkbook.SendMail Dest, Sujet, True
        ActiveWorkbook.Close savechanges:=False
    '... on continue tant qu'on n'est pas au bout du fichier
    Loop Until iMin > iMax
    MsgBox prompt:="Traitement terminé !", Buttons:=vbOKOnly, Title:="Découpage du Flash par DR"
End Sub

Aucune piste ?

Rechercher des sujets similaires à "macro envoi fichier different mail gens differents"