Con macro de busqueda

buenas tardes necesito una ayuda con una macro para buscar datos en una base de datos pero cuando el código buscado q se encuentra en la hoja1 llamada "buscar" se repite mas de una ves en la hoja2 llamada "dir" la cual es la base de datos solo me extrae los datos del primero necesito ayuda que cuando se repita me emita algún listado de cuales son los q se repiten y cual deseo usar,

si tienes algún correo para enviarte el archivo

la macro es la siguiente:

Sub Buscar()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Sheets("BUSCAR").Unprotect ("17919119")
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 "Código " & [Código] & " no encontrado", vbInformation, "AM Consultores"
Else
Copiar_datos WS, rBingo.Row
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.CutCopyMode = False
End If
End