concaténation cellules avec exception et ajout de caractère

[benoua]

Bonjour à tous!

Je pense avoir bien cherché sur le forum que je fréquente depuis peu et je n'ai pas trouvé de problèmes se rapprochant du mien.
Pour faire simple :
Il s'agit d'un échéancier :
Une dizaine d'agents ajoutent dans une même base des échéances à tenir pour l'envoi de factures, une ligne correspondant à une affaire.
Le but est d'envoyer un mail de rappel à ceux qui ont des échéances à terme.
J'ai réussi (avec l'aide d'internet) à faire en sorte que la macro envoi un mail automatiquement :
Le code (si quelqu'un a des retouches à proposer):

Sub EnvoiUnMail()
Application.ScreenUpdating = False
Dim TouchesEnvoi(5) As String
Dim MailAd As String
Dim Msg As String
Dim Subj As String
Dim URLto As String
TouchesEnvoi(0) = 2
TouchesEnvoi(1) = "^{ENTER}"
TouchesEnvoi(2) = "{ENTER}"
MailAd = Range("d1")
Subj = Range("d2")
Msg = Msg & Range("d3")
URLto = "mailto:" & MailAd & "?subject=" & Subj & "&body=" & Msg
ActiveWorkbook.FollowHyperlink Address:=URLto
Attendre 3
For i = 1 To TouchesEnvoi(0)

SendKeys TouchesEnvoi(i), True
Next i
End Sub
Sub Attendre(Secondes As Integer)

Dim Début As Long, Fin As Long, Chrono As Long
Début = Timer
Fin = Début + Secondes
Do Until Timer >= Fin
DoEvents
Loop
End Sub

Cette macro marche très bien.

Ce que je souhaite maintenant c'est que dans la case D1 dans laquelle se trouve le destinataire, je puisse mettre automatiquement l'adresse des personnes qui ont une facture à emettre (et seulement ceux-la).
J'ai donc mis un test en fin de ligne qui affiche un "1" si l'agent est OK et un "4" si celui ci doit faire une facture. (j'ai mis des valeurs bidons dans mon test que j'ai fait un peu en vitesse mais je le précise car cela vous permettra de comprendre la macro suivante). Et la valeur en F35 est fonction du nombre de ligne contenant une affaire et par conséquent un test.
Cette macro récupère les adresses mail des agents qui ont une facture à emmettre et donc pour qui le test est supérieur à 4 :

Sub fdf()

Range("B8").Select

For i = 0 To Range("f35")
Range("b8").Offset(i, 0).Select

If Range("D8").Offset(i, 0) <> "" And Range("D8").Offset(i, 0) >= 3 Then
Application.CutCopyMode = False
Selection.Copy
Range("h8").Offset(i, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Next i

End Sub

Je me retrouve donc avec une colonne dans laquelle se trouve, à la fin de chaque ligne posant problème, l'adresse mail de la personne concernée.
Je cherche donc un moyen de mettre dans une unique cellule toutes ses adresses tout en pensant à éviter les doublons, les blancs, et à ajouter un ";" entre chaque personne.
Si quelqu'un à une idée!

Edit : j'ai fait une ptite retouche de la partie de code qui récupère les adresses des lignes dont le test est supérieur 3

 

[skoobi]

Re : concaténation cellules avec exception et ajout de caractère

Bonjour et bienvenue sur XLD,

Je pense qu'un fichier ne serait pas de trop afin de pouvoir recoupé avec tous ce que tu dis.
Un support "visuel" ça aide à comprendre plus vite.

Bonne fin d'après-midi.

 

[benoua]

Re : concaténation cellules avec exception et ajout de caractère

Tout d'abord merci de t'intéresser au problème

Je n'ai aps encore réellement développé le fichier, mais je t'evnoie celui sur lequel je fais mes test de macro que je compte ensuite adapter à l'ensemble final, le but étant de toute façon le même!

 

[skoobi]

Re : concaténation cellules avec exception et ajout de caractère

Re,

Voici une proposition, la liste d'adresse est écrit en E8:

Sub test()
Dim liste As New Collection
Dim cellule As Range

On Error Resume Next
    For Each cellule In Range(Range("B8"), Range("B8").End(xlDown))
        If cellule.Value <> "" Then
            On Error Resume Next
            liste.Add cellule.Value, CStr(cellule.Value)
        End If
    Next
On Error GoTo 0
adresse = ""
For Each v In liste
If adresse = "" Then
    adresse = v
Else: adresse = adresse & ";" & v
End If
Next
Range("E8").Value = adresse
End Sub

 

[benoua]

Re : concaténation cellules avec exception et ajout de caractère

Merci beaucoup skoobi, j'essaierai ce code lundi au boulot!
Bon week end à toi!