Macro para buscar coincidencias

Hola, antes que nada gracias por este espacio.

Estoy intentando crear una macro (soy muy nuevo en el tema) copie la siguiente macro y me funciona para buscar un dato determinado,

Sub Buscar()
Dim WS As Worksheet
Dim rBingo As Range
Borrar_Form
For Each WS In ThisWorkbook.Worksheets
If WS.Name Like "Dir*" Then
Set rBingo = WS.Cells.Find(what:=[Código], lookat:=xlWhole)
If Not rBingo Is Nothing Then Exit For
End If
Next WS
If rBingo Is Nothing Then
' No encontrado
MsgBox "Descripción " & [Código] & " no encontrada", vbInformation
Else
Copiar_datos WS, rBingo.Row
End If
End Sub
Sub Borrar_Form()
Dim rCell As Range
Set rCell = [Datos]
Do While rCell <> ""
rCell.Offset(0, 1).Value = ""
Set rCell = rCell.Offset(1, 0)
Loop
[Nota].Value = ""
End Sub
Sub Copiar_datos(ByRef queWS As Worksheet, ByVal queFila As Long)
Dim rCell As Range
Set rCell = [Datos]
On Error Resume Next
Do While rCell <> ""
rCell.Offset(0, 1) = queWS.Cells(queFila, queWS.Rows(1).Find(rCell.Value).Column)
Set rCell = rCell.Offset(1, 0)
Loop
On Error GoTo 0
[Nota].Value = "El dato está en la hoja " & queWS.Name & ", en la fila " & Format(queFila, "#,##0")
End Sub

Estoy intentando crear una macro con un botón activex para que me busqué las coincidencias asociadas a este dato: Ej: El dato es descripción y en descripción pongo deportes y existen varias repeticiones y solo me busca la primera.LA idea es que con el botón busque todas las descripciones que coinciden, algo similar a la función de un formulario de siguiente y anterior.