Buscar registros coincidentes en una hoja, si los encuentra, pegarlos en una 3a hoja

Buenas noches,

Tengo la hoja "Datos" con la siguiente información:

Referencia
1
2
3
4
5
6
7
8

Quiero buscar todos los valores coincidentes en la hoja "Base" columna "B", en dicha hoja hay valores en las columnas a la derecha, de las cuales quiero que copie la columna B, D y E; cada vez que encuentre el valor coincidente debe copiarlos y pegarlos en una 3a hoja que se llama "Resultado".

Tengo el siguiente código, sin embargo no he podido hacer que lo haga para el siguiente registro, solo me trae el primero que encuentra.

Sub Derrama()
dato = Sheets("Datos").Range("B2").Value
If Range("B2").Value = "" Then
primer_dato = 2
Else
primer_dato = Range("B" & Cells.Rows.Count).End(xlUp).Row + 1
End If
Sheets("Base").Select
Dim Comprobar, Contador
Comprobar = True: Contador = 0 ' Inicializa variables.
Do 'Bucle externo.
Do While Contador < 65000 ' Bucle interno.
Contador = Contador + 1 ' Incrementa el contador.
If Range("B" & Contador).Value <> "" Then ' Si la condición es verdadera.
If Range("B" & Contador).Value = dato Then
Range("A" & Contador & ":E" & Contador).Select
Selection.Copy
Sheets("Resultado").Select
Range("A" & primer_dato).Select
ActiveSheet.Paste
Application.CutCopyMode = False
primer_dato = primer_dato
Sheets("Resultado").Select
End If
Else
Comprobar = False ' Establece el valor a False.
Exit Do ' Sale del bucle interno.
End If
Loop
Loop Until Comprobar = False ' Sale inmediatamente
Sheets("Resultado").Select
End Sub

Gracias de antemano por su apoyo.

Saludos,