Remplacer les caracteres par un code

Bonjour,

je cherche à remplacer un ensemble de caractère (nom) par un code. Les caractères ou les noms sont répétitifs. Mais le code est unique pour chaque nom.... Mon code ne me permet pas de remplir la colonne code.

Autre informations : Les noms (qui sont répétitifs )sont sur la feuille regularite, le code associé à a chaque nom est sur la feuille Gare et je veux insérer chaque code pour chaque nom sur la feuille regulariteBru.

Sub rechercher_remplacer()

'recherche et remplace X par Y dans "Sheet1"

Dim i As Integer

Dim m As Integer

For m = 2 To 33

For i = 6 To 1004

If Worksheets("regularite").Cells(i, 4).Value = Worksheets("Gare").Cells(m, 2).Value Then

Worksheets("regulariteBru").Cells(i, 4).Value = Worksheets("Gare").Cells(m, 1).Value

Else

m = m + 1

Worksheets("regulariteBru").Cells(i, 4).Value = Worksheets("Gare").Cells(m, 1).Value

i = i + 1

End If

Next i

Next m

End Sub

Bonsoir

proposition de correction

Sub rechercher_remplacer()
'recherche et remplace X par Y dans "Sheet1"
    Dim i As Integer
    Dim m As Integer
    dl = Sheets("regularitebru").Cells(Rows.Count, 5).End(xlUp).Row
    For i = 6 To dl
        Set re = Worksheets("Gare").Range("B2:B33").Find(Worksheets("regularitebru").Cells(i, 5), lookat:=xlWhole)
        If Not re Is Nothing Then
            Worksheets("regularitebru").Cells(i, 4) = re.Offset(, -1)
        End If
    Next i
End Sub

Meilleure proposition ! Merci beaucoup, çà marche super bien