Microsoft 365 recherche d'un élément dans une plage

Option Explicit

Sub completer_Cat()
    Dim dl As Long, d As Object, i As Long, cle, Rng As Range, c As Range
    Set d = CreateObject("scripting.dictionary")
    With Feuil1    'à adapter
        If Feuil1.AutoFilterMode = True Then Feuil1.AutoFilter.ShowAllData
        dl = .Range("A" & Rows.Count).End(xlUp).Row
        Set Rng = .Range("A2:D" & dl)

        For i = 2 To dl
            If .Range("B" & i).Offset(0, 2) <> "" Then
                d(.Range("B" & i)) = .Range("B" & i).Offset(0, 2)
            End If
        Next i

        If d.Count > 0 Then
            For Each cle In d.keys
                Rng.AutoFilter Field:=2, Criteria1:=cle
                For Each c In Rng.SpecialCells(xlCellTypeVisible)
                    If Cells(c.Row, 4) = "" Then Cells(c.Row, 4).Value = d.Item(cle)
                Next c
            Next cle
        End If
        Rng.AutoFilter Field:=2
    End With

    MsgBox "Traitement terminé!", vbInformation + vbOKOnly, "FIN TRAITEMENT"
    Set Rng = Nothing: Set d = Nothing
End Sub