Macro para buscar registros específicos y copiarlos a otra columna

Te mando la solución a tu ejemplo:

Tenemos la columna B con datos diversos y entre ellos se repiten y se repiten contenidos. En la columna C tenemos otros datos...

Ahora ejecuta esta macro y todo listo!

(En mi ejemplo estamos trabajando en una hoja llamada hoja1)

Sub prueba()
'por Luismondelo
fila = 1
dato = InputBox("que dato o parte de dato buscamos??")
If dato = "" Then Exit Sub
Set busca = Sheets("hoja1").Range("b1:b" & Sheets("hoja1").Range("b65000").End(xlUp).Row).Find(dato, LookIn:=xlValues, lookat:=xlPart)
If Not busca Is Nothing Then
ubica = busca.Address
Do
Cells(fila, 5).Value = busca.Value
Cells(fila, 6).Value = busca.Offset(0, 1)
fila = fila + 1
Set busca = Sheets("hoja1").Range("b1:b" & Sheets("hoja1").Range("b65000").End(xlUp).Row).FindNext(busca)
Loop While Not busca Is Nothing And busca.Address <> ubica
End If
End Sub

recuerda finalizar y puntuar

Hola, buenas tardes, antes q nada muchas gracias por la respuesta tan rápida y eficaz, la macro funciona perfectamente, solo que quizá no me supe explicar, lo q en realidad necesito creo q es mas sencillo, lo q quiero q haga la macro es q por ejemplo mis datos están en la columna B, y con el inputbox yo le pido q me seleccione por ejemplo, S/N y ese mismo dato q se repite muchas veces en la columna B, me lo ponga en la misma fila pero 4 columnas a la derecha. muchas gracias por su atención.

A B C D E F

1 12

2 S/N S/N

3 20

4 65

5 S/N S/N

Ok, prueba con esta macro para realizar el ejemplo que has mandado en el último post:

Sub ejemplo()
'por luismondelo
dato = InputBox("que dato buscamos??")
dato = LCase(dato)
If dato = "" Then Exit Sub
Range("b1").Select
Do While ActiveCell.Value <> ""
valor = ActiveCell
contarsi = Application.WorksheetFunction.CountIf(Columns(2), valor)
If LCase(ActiveCell) = dato And contarsi > 1 Then
ActiveCell.Offset(0, 4).Value = ActiveCell
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub