VBA: comparer 2 feuilles &copier des cellules

Bonjour,
Bonjour a tous,

Je me tourne vers vous pour avoir un regards neuf sur ma macro dont voici le but:
Je cherche a comparer les valeurs de la colonne B de la feuille "New Deal" avec la colonne A de la feuille "All Deal" et apres de copier des celulles specifiques lorsceque les valeurs sont similaires.

Quand les valeurs sont similaires, je souhaite copier la cellule 25 de la ligne (ou on a trouver la similitude) de la feuille All Deal vers la cellule 15 de la feuille new Deal sur la ligne ou il y a la similitude

Par exemple: La macro trouve une similitude entre la ligne 5 de la feuille "New Deal" avec ligne 10 de la feuille "All Deal". je veux copier la cellule 25 de la ligne 10 de "All Deal" vers la 15eme cellule de la ligne 5 de 'New Deal"

Voici mon code pour le moment. Il effectue la recherche et la comparaison entre les 2 colonnes sans aucun pb. Il est capable de trouver la cellule a copier sans aucun souci. Le probleme survient lorsqu'il s'agir de copier/coller la cellule dans la feuille "New Deal"

Merci pour votre aide et vos commentaires sur mon codes

Nibor

Sub comment()


Dim rng1 As Range
Dim rng2 As Range
Dim RowNo As Long
Dim liste() As Integer
Dim C As Range
Dim i As Integer

Set rng1 = Worksheets("New Data").Range("B2", Worksheets("New Data").Range("B" & Rows.Count).End(xlUp))
Set rng2 = Worksheets("All Deal").Range("A6", Worksheets("All Deal").Range("A" & Rows.Count).End(xlUp))
ReDim liste(0)
For Each C In rng1
If Application.WorksheetFunction.CountIf(rng2, C) > 0 Then
ReDim Preserve liste(UBound(liste) + 1)
liste(UBound(liste)) = C.Row
End If
Next C
'
For i = UBound(liste) To 1 Step -1
Worksheets("All Deal").Activate
Worksheets("All Deal").Range(Cells(liste(i), 25), Cells(liste(i), 25)).Copy
Worksheets("New Data").Activate
Worksheets("New Data").Range(Cells(liste(i), 15), Cells(liste(i), 15)).Insert



Next
End Sub