Recherche V concaténée si valeurs recherchées identiques

Bonjour,

Je souhaite savoir s'il est possible de concaténer des celulles en partant d'une recherche V - mais il faudrait que je concatène si les valeurs recherchées sont identiques :

Pour exemple :

Du coup je suppose que j'aurais des doublons mais je me débrouillerai pour ne garder qu'une version d'adresse email à chaque fois.

Désolée si le sujet a déjà été traité ou si la demande est simple ! Je n'ai pas trouvé en cherchant avec les mots clés.

Merci par avance !

Hello,

En vba (il y a certainement + simple mais j'ai que ça qui me viens à l'idée pour le moment )

Sub ConcatAdress()
    Dim lngRow&, lngNbAdress&, i&, lngTmpNb&, lngTmpNb2&
    Dim strAddress$
    Dim varTmpArr As Variant, varAddressArr As Variant, varDicoKey As Variant
    Dim objDicoAdress As Object

    For i = 1 To 3
        Select Case i
            Case Is = 1
                Set objDicoAdress = CreateObject("Scripting.Dictionary")
                lngRow& = 2
                Do While Not Cells(lngRow&, 1) = vbNullString
                    strAddress$ = Cells(lngRow&, 1).Value
                    If Not objDicoAdress.exists(strAddress$) Then objDicoAdress.Add strAddress$, lngRow&
                    lngRow& = lngRow& + 1
                Loop
            Case Is = 2
                ReDim varAddressArr(1 To objDicoAdress.Count, 1 To 2)
                lngTmpNb2& = 1
                For Each varDicoKey In objDicoAdress.Keys
                    lngTmpNb& = 1
                    lngNbAdress& = Application.WorksheetFunction.CountIf(Columns(1), varDicoKey)
                    ReDim varTmpArr(1 To lngNbAdress&)
                    lngRow& = 2
                    Do While Not Cells(lngRow&, 1) = vbNullString
                        strAddress$ = Cells(lngRow&, 1).Value
                        If strAddress$ = varDicoKey Then
                            varTmpArr(lngTmpNb&) = Cells(lngRow&, 2).Value
                            lngTmpNb& = lngTmpNb& + 1
                        End If
                        lngRow& = lngRow& + 1
                    Loop
                    varAddressArr(lngTmpNb2&, 1) = varDicoKey
                    varAddressArr(lngTmpNb2&, 2) = Join(varTmpArr, ",")
                    lngTmpNb2& = lngTmpNb2& + 1
                Next varDicoKey
            Case Is = 3
                lngRow& = 2
                Do While Not Cells(lngRow&, 1) = vbNullString
                    strAddress$ = Cells(lngRow&, 1).Value
                    For lngTmpNb& = LBound(varAddressArr, 1) To UBound(varAddressArr, 1)
                        If varAddressArr(lngTmpNb&, 1) = strAddress$ Then Cells(lngRow&, 3) = varAddressArr(lngTmpNb&, 2)
                    Next lngTmpNb&
                    lngRow& = lngRow& + 1
                Loop
        End Select
    Next i
    Set objDicoAdress = Nothing

End Sub

Bonjour et bienvenue,
Une proposition avec Power Query.
Pour Excel 2010 2013, il est nécessaire d'installer le complément gratuit de Microsoft.
A te relire.
Cdlt.