Fusionner deux listes

Bonjour,

Je souhaite fusionner deux listes. Dans un même fichier j'ai deux feuilles.

Sur la première, un ID et des attributs, sur la seconde d'autres attributs.

L'ID est composé de 5 chiffres, les 5 derniers d'un numéro de téléphone. Sur la seconde feuille dans la colonne description je retrouve le numéro de téléphone complet avec d'autres commentaires.

Exemple ID '22222' description 'BFGLOP4 - FR_FAX - 8331622222'

Est-il possible de fusionner les deux feuilles a partir de ce match ? Avoir une fonction ou une macro qui recherche l'ID et copie la ligne correspondante d'une feuille vers l'autre ?

Sur la feuille 3 j'ai mis le résultat que j'aimerais pouvoir obtenir... Mais pas manuellement :p (le fichier comporte plus ou moins 3000 entrées).

Merci

Bonjour,

Essai (à adapter éventuellement).

Sub FusionnerListe()
    Dim Lst, d As Object, k, n%, i%, j%, ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
    Set d = CreateObject("Scripting.Dictionary")
    With ws1
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To n
            k = CStr(.Cells(i, 1)): d(k) = i & "|" & 0
        Next i
    End With
    With ws2
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To n
            k = Right(.Cells(i, 4), 5)
            If d.exists(k) Then
                d(k) = Replace(d(k), "0", i)
            Else
                d(k) = 0 & "|" & i
            End If
        Next i
    End With
    n = 1
    With Worksheets("Sheet3")
        .Range("A1").CurrentRegion.Offset(1).ClearContents
        For Each k In d.keys
            i = CInt(Split(d(k), "|")(0))
            j = CInt(Split(d(k), "|")(1))
            n = n + 1
            If i > 0 Then
                Lst = ws1.Cells(i, 1).Resize(, 9).Value
                .Cells(n, 1).Resize(, 9).Value = Lst
            Else
                .Cells(n, 1) = CLng(k)
            End If
            If j > 0 Then
                Lst = ws2.Cells(j, 1).Resize(, 4).Value
                .Cells(n, 10).Resize(, 4).Value = Lst
            End If
        Next k
        .Activate
    End With
End Sub

Cordialement.

bonjour

salut MFerrand

sans VBA, avec la formule RECHERCHEV

il faudra peut-être créer une colonne = DROITE (BFGLOP4 - FR_FAX - 8331622222 ; 10) pour obtenir une colonne de n° de tél propre.