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
[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!
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
