Macro para buscar, luego copiar y pegar campos específicos

Desde Costa Rica! ¿Alguien me podría ayudar con una macro de VBA para lograr hacer esto?:

- Un dato que está en la hoja "Registro" buscarlo en la hoja "Datos" y en esa hoja Datos pegar en la misma fila algunos campos en unas columnas en específico que están en la hoja Registro en columna.

Muchas gracias de antemano! Soy principiante en VBA por lo si pudieran ser muy específicos en cuales campos de la macro debo modificar se los voy a agradecer miles.

2 respuestas

Respuesta
1

[Hola 

Te paso la macro


Valora la respuesta para finalizar saludos!

Sub actualiza_dato()
    '
    'Por Adriel Ortiz
    Set h1 = Sheets("Registro") ' Hoja1
    Set h2 = Sheets("Datos")    ' Hoja2
    '
    dato = h1.Range("A2")   'Dato a buscar
    '
    Set b = h2.Columns("A").Find(Val(dato), lookat:=xlWhole)
        If Not b Is Nothing Then
            h2.Cells(b.Row, "B") = h1.Range("B2")
            h2.Cells(b.Row, "C") = h1.Range("C2")
            MsgBox "fin"
        Else
            MsgBox "Dato no encontrado", vbInformation
        End If
End Sub

Muchas gracias, por favor sálvame de esta y pásamela exacto como debo pegarla y que funcione, debo programar esto para ya y pensé que iba a ser más fácil, no soy buena interpretando el código de la macro:

- El dato a buscar está en la hoja "REGISTRO & ACTUALIZACIÓN" en el campo G2

- Este dato anterior lo debe buscar en la columna A de la hoja "DATOS" y cuando coincida debe pegar los datos de origen que están en forma vertical (es decir, al pegar debe trasponer y pegar solo valores) en la hoja REGISTRO Y ACTUALIZACIÓN en los campos de G3 a a G19, esto deberá pegarse en la fila que corresponda en la hoja DATOS en las columnas de la B a la R.

Agradezco muchísimo la ayuda.

Saludos!

[Hola

Envíame tu archivo con un ejemplo del resultado

email: [email protected]

Te paso la macro


Valora la respuesta para finalizar saludos!

Sub buscar_Datos()
'Por Adriel Ortiz
' Buscar
'
    Set h1 = Sheets("REGISTRO & ACTUALIZACIÓN")
    Set h2 = Sheets("DATOS")
    '
        If h1.Range("I2") = "" Then
            MsgBox "Ingrese código a buscar"
            Exit Sub
        End If
    '
        Set b = h2.Columns("A").Find(h1.[I2], lookat:=xlWhole)
            If Not b Is Nothing Then
                ncell = b.Row
                h1.[I3] = h2.Cells(ncell, "B")
                h1.[I4] = h2.Cells(ncell, "C")
                h1.[I5] = h2.Cells(ncell, "D")
                h1.[I6] = h2.Cells(ncell, "E")
                h1.[I7] = h2.Cells(ncell, "F")
                h1.[I8] = h2.Cells(ncell, "G")
                h1.[I9] = h2.Cells(ncell, "H")
                h1.[I10] = h2.Cells(ncell, "I")
                h1.[I11] = h2.Cells(ncell, "J")
                h1.[I12] = h2.Cells(ncell, "K")
                h1.[I13] = h2.Cells(ncell, "L")
                h1.[I14] = h2.Cells(ncell, "M")
                h1.[I15] = h2.Cells(ncell, "N")
                h1.[I16] = h2.Cells(ncell, "O")
                h1.[I17] = h2.Cells(ncell, "P")
                h1.[I18] = h2.Cells(ncell, "Q")
                h1.[I19] = h2.Cells(ncell, "R")
            Else
            MsgBox "No existe el código"
            End If
End Sub
'
'
Sub actualizar()
'Por Adriel ortiz
'Actualizar
Set h1 = Sheets("REGISTRO & ACTUALIZACIÓN")
    Set h2 = Sheets("DATOS")
    '
    If MsgBox("Es seguro de actualizar los datos?", vbOKCancel) = vbOK Then
        Set b = h2.Columns("A").Find(h1.[I2], lookat:=xlWhole)
            If Not b Is Nothing Then
                ncell = b.Row
                h2.Cells(ncell, "B") = CDate(h1.[I3])
                h2.Cells(ncell, "C") = h1.[I4]
                h2.Cells(ncell, "D") = h1.[I5]
                h2.Cells(ncell, "E") = h1.[I6]
                h2.Cells(ncell, "F") = h1.[I7]
                h2.Cells(ncell, "G") = h1.[I8]
                h2.Cells(ncell, "H") = h1.[I9]
                h2.Cells(ncell, "I") = h1.[I10]
                h2.Cells(ncell, "J") = h1.[I11]
                h2.Cells(ncell, "K") = h1.[I12]
                h2.Cells(ncell, "L") = h1.[I13]
                h2.Cells(ncell, "M") = h1.[I14]
                h2.Cells(ncell, "N") = h1.[I15]
                h2.Cells(ncell, "O") = h1.[I16]
                h2.Cells(ncell, "P") = h1.[I17]
                h2.Cells(ncell, "Q") = h1.[I18]
                h2.Cells(ncell, "R") = h1.[I19]
                MsgBox "Actualizados con exito"
            End If
        End If
End Sub
Respuesta

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas