Macro envoi fichier différent par mail à des gens différents
F
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