XL 2010 Comparaisons de valeurs entre 2 colones et alignement des valeurs identiques

[remi65]

Bonjour à tous et à toutes,

J'ai un tableau de 2 colonnes avec des valeurs.
Certaine sont identique dans chaque colonnes.
Voici le dis tableau

Les valeurs en vert, sont les valeurs présentent dans les 2 colonnes (effectué avec une simple mise en forme conditionnelle).
Ce que je cherche à faire :
Aligner les valeurs identiques. exemple :

J'y sui arrivé "partiellement".

Mon souci : faire la recherche d'une valeurs de la colonne de gauche dans celle de droite et comparer la valeurs.
Comme je ne connais que les boucles For / Next et If / EndIf j'ai un peu de mal.

En effet, avec mon code je ne fait la vérification que sur une ligne et non sur l'ensemble du tableau.

Pouvez-vous m'éclairer ?

Merci d'avance.

Salutation

 

[sousou]

Bonjour
Un fichier exemple serait le bien-venu explication dans la chartre

 

[remi65]

J'ai mis le tableau en image, je ne peux pas fournir le tableau complet, certaine info sont sous le secret industriel ^^

à moins que tu parle du code que j'ai réalisé @sousou ?

voici le résultat final que je souhaite obtenir :

 

[sousou]

Fait une extraction dans un nouveau fichier, pour que nous n'ayons pas à reconstruire ton fichier

 

[remi65]

Et voilà

 

[remi65]

Bonjour, on m'a aider ailleurs, j'ai trouvé la solution que voici :

Dim tablo As Variant
Dim derlign1 As Long, derlign2 As Long
Dim i As Long, t As Variant, laplage As Range, f As Range, j As Long
 
With Worksheets(1)
 
        derlign1 = .Cells(.Rows.Count, 7).End(xlUp).Row
        derlign2 = .Cells(.Rows.Count, 8).End(xlUp).Row
        With .Range("H6:H" & derlign2)
                tablo = .Value
                .ClearContents
        End With
        For i = 6 To derlign1
                t = Application.Match(.Cells(i, 7).Value, tablo, 0)
                .Cells(i, 8).Value = IIf(IsError(t) = False, .Cells(i, 7).Value, "")
        Next i
        Set laplage = .Range("G6:G" & derlign1)
        For j = LBound(tablo) To UBound(tablo)
                Set f = laplage.Find(tablo(j, 1), LookIn:=xlValues, lookat:=xlWhole)
                If f Is Nothing Then
                       .Range("G" & j + 5, "H" & j + 5).Insert Shift:=xlDown
                       .Cells(j + 5, 7).Value = ""
                       .Cells(j + 5, 8).Value = tablo(j, 1)
                Else
                       Set f = Nothing
                End If
         Next j
        Set laplage = Nothing
 
End With
 
Erase tablo

Bonne journée

 

[sousou]

Bonjour
Si tu as la solution tout va bene tu peux mettre le poste résolu