Con el numero de documento traer a otra hoja dirección teléfono etc

Esta macro me carga si coloco uno por uno pero si pego varios en la columna no, alguien me ayuda a corregir por favor

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column <> 1 Then Exit Sub
Dim mihoja As String, Donde As String
Dim Quebusco As String
Dim resulta As Object
Dim ubicado As String
'la variable mihoja guarda la hoja donde se hará la búsqueda
mihoja = "Octubre"
'la variable Donde guarda el rango donde debe efectuarse la búsqueda
Donde = "B2:B10000"
'la variable Quebusco guarda el dato a buscar que se encuentra en la celda B2
Quebusco = Target.Value
'se crea un objeto con el resultado de la función Find
Set resulta = Sheets(mihoja).Range(Donde).Find(Quebusco, LookIn:=xlValues, LookAt:=xlWhole)
If resulta Is Nothing Then
'si no se encuentra el dato puede mostrar un mensaje de error como el siguiente
'MsgBox "No se encontró el dato", vbCritical, "NO ENCONTRADO"
Else
'si encontró el dato devolverá a continuación el resto de datos
Target.Offset(0, 1).Value = resulta.Offset(0, 1)
Target.Offset(0, 2).Value = resulta.Offset(0, 2)
Target.Offset(0, 3).Value = resulta.Offset(0, 3)
Target.Offset(0, 4).Value = resulta.Offset(0, 6)
Target.Offset(0, 5).Value = resulta.Offset(0, 8)
Target.Offset(0, 6).Value = resulta.Offset(0, 9)
Target.Offset(0, 7).Value = resulta.Offset(0, 10)
'continuar con el resto de campos
End If
'se limpia la variable
Set resulta = Nothing

End Sub