Macro buscar coincidentes en excel en otra hoja, y si encuentra copiar y pegar en otra hoja.

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

2 Respuestas

Respuesta
2

Puedes enviarme tu archivo con ejemplos de lo que tienes y de lo que esperas como resultado.

a [email protected]
En el a correo escribe tu nombre de usuario y el título de esta pregunta.
Saludos. Dante Amor

No funciona mi correo, te pongo aquí el archivo para que lo descargues

https://www.dropbox.com/s/bc4jpjq2oztk26v/Macro%20dam.xlsm

Respuesta

¿Tengo una duda como puedo hacer un buscarv con macros de una hoja a otra?

Tengo el siguiente código pero al correrlo no me arroja resultado

Sub PRUEBA()

With Worksheets("Hoja2").Range("B2:B16" & fin)
.Formula = "=IF(ISERROR(buscarv(Hoja1!A2:B16,2,FALSE)),"""",buscarv(Hoja1!A2:B16,2,FALSE))"
.Formula = .Value
End With

End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas