Buscar un valor y copiar toda la fila
Lo que estoy necesitando es buscar un valor de una tabla en otra y una vez encontrado copiar la fila completa a una nueva hoja.
Seria algo así:
Esta seria la primera tabla
1 aaa 213 bbb
2 bbb 343 ddd
3 rrrr 434 rrrr
Y la segunda seria algo así
1 213
2 343
Entonces en este caso buscaría los valores 213 y 343 y en mi nueva hoja tendría que quedar así:
1 aaa 213 bbb
2 bbb 343 ddd
La segunda tabla no esta en orden.
Bueno si necesitan algún dato más avisen que les digo.
Seria algo así:
Esta seria la primera tabla
1 aaa 213 bbb
2 bbb 343 ddd
3 rrrr 434 rrrr
Y la segunda seria algo así
1 213
2 343
Entonces en este caso buscaría los valores 213 y 343 y en mi nueva hoja tendría que quedar así:
1 aaa 213 bbb
2 bbb 343 ddd
La segunda tabla no esta en orden.
Bueno si necesitan algún dato más avisen que les digo.
1 Respuesta
Respuesta de nilton31a
1
Espero te sirva la siguiente respuesta, contemplando que tendrás que adecuarlo a tus hoas y columnas, toma en cuenta que la macro te preguntara si deseas copiar los datos y lo ara por ti hasta terminar el listado o los datos a buscar...
Sub encontrado()
Sheets("hoja1").Select
2 Range("f1").Select
3 Posicion = 1
4 While ActiveCell.Value <> ""
5 valorcomparacion = ActiveCell.Value
Sheets("hoja1").Select
Range("b1").Select
Salir = "no"
While ActiveCell.Value <> "" And Salir = "no"
If ActiveCell.Value = valorcomparacion Then
respuesta = MsgBox("¿Deseas copiar este dato?", 4, "¡¡Encontrado!!")
If respuesta = vbYes Then
Selection.End(xlToLeft).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("hoja1").Select
Range("H1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveWindow.LargeScroll ToRight:=-1
End If
Salir = "si"
Else
ActiveCell.Offset(1, 0).Range("A1").Select
End If
Wend
Posicion = Posicion + 1
Sheets("hoja1").Select
Range("f1").Select
ActiveCell.Offset(Posicion - 1, 0).Range("a1").Select
Wend
End Sub
Saludos, no olvides responder o finalizar la pregunta.
Sub encontrado()
Sheets("hoja1").Select
2 Range("f1").Select
3 Posicion = 1
4 While ActiveCell.Value <> ""
5 valorcomparacion = ActiveCell.Value
Sheets("hoja1").Select
Range("b1").Select
Salir = "no"
While ActiveCell.Value <> "" And Salir = "no"
If ActiveCell.Value = valorcomparacion Then
respuesta = MsgBox("¿Deseas copiar este dato?", 4, "¡¡Encontrado!!")
If respuesta = vbYes Then
Selection.End(xlToLeft).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("hoja1").Select
Range("H1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveWindow.LargeScroll ToRight:=-1
End If
Salir = "si"
Else
ActiveCell.Offset(1, 0).Range("A1").Select
End If
Wend
Posicion = Posicion + 1
Sheets("hoja1").Select
Range("f1").Select
ActiveCell.Offset(Posicion - 1, 0).Range("a1").Select
Wend
End Sub
Saludos, no olvides responder o finalizar la pregunta.
Primero pido mil disculpas por no haber finalizado antes la consulta. La verdad se me paso.
Con respecto a la respuesta la verdad que agradezco la dedicación y el tiempo del experto pero al final un amigo me ayudo.
Un saludo
Y gracias.
Con respecto a la respuesta la verdad que agradezco la dedicación y el tiempo del experto pero al final un amigo me ayudo.
Un saludo
Y gracias.
