Macro para buscar, encontrar y copiar datos especificos

Tengo un libro con 2 hojas, hoja1 y hoja2, en la hoja2 tengo una base de datos de la siguiente manera: (Ej. Juan, tengo muchos mas con diferentes nombres e información diferente pero en el mismo orden)

A B C D E

1 JUAN

2 1/1/14  INGRESOS 1 1ER SEM 100.00

3   2/1/14       DIARIO               1              2DO SEM                           200.00  

4 3/1/14  INGRESOS 1 TERCER SEM 50.00

5 Total 350.00

El caso es que quiero que en hoja1 mediante una búsqueda poniendo en a:1 el nombre de "JUAN" me de el resultado 2 filas abajo, osea en a:4, el resultado que deseo seria la búsqueda de JUAN en la hoja2, buscando en la columna A y una vez encontrado copiar las celdas que contengan información a partir de que se encuentre JUAN, es decir que me copie en este caso de a2 a e5., ojala me puedan ayudar.

Fco. Zapata

1 respuesta

Respuesta
2

Pon la siguiente macro en los eventos de la hoja. Cada vez que modifiques la celda A1 de la hoja 1 te hará la búsqueda en automático.

Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
    If Target.Address(False, False) = "A1" Then
        Set h1 = Sheets("Hoja1")
        Set h2 = Sheets("Hoja2")
        j = 4
        Set b = h2.Columns("A").Find(h1.[A1])
        If Not b Is Nothing Then
            For i = b.Row + 1 To h2.Range("A" & Rows.Count).End(xlUp).Row
                If h2.Cells(i, "A") = "" Then Exit For
                h2.Rows(i).Copy
                h1.Rows(j).PasteSpecial
                j = j + 1
            Next
        End If
    End If
End Sub

Sigue las Instrucciones para poner la macro en worksheet

  1. Abre tu libro de excel
  2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
  3. Del lado izquierdo dice: VBAProject, abajo dale doble click a worksheet(tu hoja)
  4. Del lado derecho copia la macro

Buenas tardes Dante Amor, es justamente lo que necesito solo que con algunos ajustes, podrías hacer que no copie toda la fija, si no que copie hasta la ultima celda ocupada en la columna? ya que después del resultado tengo que hacer otro procedo en las columnas derechas de la hoja1., otra cosa, he creado un botón (control de formulario) que va cambiando los nombres uno por uno, es posible ligar tu macro al botón (que por cierto es una formula de búsqueda) para que cada vez que cambie de nombre me de automáticamente el mismo resultado? espero que mi explicación sea comprensible y de antemano mil gracias.

Para copiar hasta la última columna

Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
        If Target.Address(False, False) = "A1" Then
        Set h1 = Sheets("Hoja1")
        Set h2 = Sheets("Hoja2")
        j = 4
        Set b = h2.Columns("A").Find(h1.[A1])
        If Not b Is Nothing Then
            For i = b.Row + 1 To h2.Range("A" & Rows.Count).End(xlUp).Row
                If h2.Cells(i, "A") = "" Then Exit For
                c = h2.Cells(i, Columns.Count).End(xlToLeft).Column
                h2.Range(h2.Cells(i, "A"), h2.Cells(i, c)).Copy
                h1.Cells(j, 1).PasteSpecial
                j = j + 1
            Next
        End If
    End If
End Sub

Con gusto te sigo ayudando, puedes crear una pregunta nueva para cada petición. Si gustas en el título de la pregunta puedes comentar que va dirigida a Dante Amor.

¡Gracias! Dante Amor, tu aportación me ha sido muy útil.

Saludos desde Cancún México.

Atte. Fco. Zapata

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas