Crear Macro que copie datos de una hoja a otra
Necesito crear una Macro que pregunte un valor luego lo busque en la columna A (A7:A5000), y cuando ubique el dato copie la celda en la hoja2 en la celda D4, la celda a la par de la ubicada sea copiada en la celda D8 y la que se encuentra a la par sea copiada en la hoja2 en la celda C10
Las 3 celdas de la hoja1 que son copiadas, una vez que se haya el valor son de las misma fila A, B, C pero se copian en esos 3 espacios separados en la hoja2
En caso que el valor no exista despliega un mensaje indicándolo y se detiene
.09.01.17
Buenas, Karlos
La siguiente rutina hace lo que solicitas.
Accede al Editor de VBA (Atajo: Alt + F11), allí inserta un módulo (Insertar-Módulo) y pega el siguiente código:
Sub BuscaDatos()
'---- Variables modificables ----
'=== KARLOS, modifica estos datos de acuerdo a tu proyecto:
RangoBusq = "A7:A5000" ' Rango donde buscar datos
HojaDest = "Hoja2" ' Hoja donde dejar lo encontrado
Celdest1 = "D4" 'celda donde dejar primer dato a la par
Celdest2 = "D8" 'celda donde dejar segundo dato a la par
Celdest3 = "C10" 'celda donde dejar tercer dato a la par
'---- fin Variables
'
'---- inicio de rutina:
'
cont = 0
Buscar = InputBox("ingresar el item a buscar " & Chr(10) & "(Cancelar o dejar en blanco para salir)", "RUTINA DE BUSQUEDA")
If Len(Buscar) Then
On Error Resume Next
Encontrado = Cells.Find(What:=Buscar, LookAt:=xlWhole).Address
If Err.Number = 0 And Len(Encontrado) > 0 Then
Sheets(HojaDest).Range(Celdest1).Value = Range(Encontrado).Offset(0, 1).Value
Sheets(HojaDest).Range(Celdest2).Value = Range(Encontrado).Offset(0, 2).Value
Sheets(HojaDest).Range(Celdest3).Value = Range(Encontrado).Offset(0, 3).Value
cont = 1
End If
Err.Clear
On Error GoTo 0
End If
ElMensaje = IIf(cont = 0, "NO ", "") & "SE ENCONTRO " & IIf(Len(Buscar), Buscar, "<vacio>")
TipoMens = IIf(cont = 0, vbCritical, vbInformation)
ElTitulo = IIf(cont = 0, "NO SE HIZO NADA", "TERMINADO!")
MsgBox ElMensaje, TipoMens, ElTitulo
End SubNota que, al principio del código, hay unas variables para que lo adaptes a tu archivo, o modificarlas a gusto.
Esto responde a lo que pedías.
De todos modos, me parece lejos más práctico usar una fórmula de BUSCARV() colocada en cada una de las celdas de destino, como la siguiente:
=BUSCARV($A$1;Hoja1!$A$6:$F$5000;2;0)
[Considera si usas comas o punto y coma para separar argumentos de las funciones. Yo usé ";"]
Además, asumo que el valor a buscar está en la celda A1 de la Hoja 2, pero puede estar en otro lugar.
Asígnale el formato deseado y, luego, copia esta celda y pégala en las otras dos celdas.
Luego sólo tendrás que cambiar el número de columna de donde traer el dato (lo que te marqué en negritas)
Finalmente para que te avise que no encontró un valor puedes usar esta variante combinada con un condicional:
=SI(ESNOD(BUSCARV($A$1;Hoja1!$A$6:$D$19;1;0));"No encontrado";BUSCARV($A$1;Hoja1!$A$6:$D$19;2;0))
Es decir que si pegas esta misma fórmula en la D8 y cambias el 2 por un 3, traerá la segunda columna a la par.
y en C10
=SI(ESNOD(BUSCARV($A$1;Hoja1!$A$6:$D$19;1;0));"No encontrado";BUSCARV($A$1;Hoja1!$A$6:$D$19;4;0))
Para que traiga el tercer valor a la par del encontrado.
La ventaja de usar la fórmula es que se actualiza automáticamente sin necesidad de acordarse de ejecutar macro alguna.
Como fuere, tienes dos soluciones para lo que buscabas.
Si así fuera, agradeceré que califiques mi contribución o escribeme de nuevo aquí, si necesitas más apoyo con esto.
Un abrazo
Fernando
.
¡Gracias!
Perfecto la rutina funciona como la ocupo
Originalmente pensé en usar buscarv como sugieres pero prefiero la macro para este caso y con lo claro que lo escribiste ya entendí como ampliarlo cuando sea necesario
Muchas gracias
Hay alguna forma de adaptarla de modo que la macro se corra desde la hoja2 y no desde la hoja1
.
Hola, Karlos
Por principio respondo a lo que solicita el usuario, toda vez que -de este lado- no vemos todo el contexto donde funciona lo que está pidiendo. Por ello, desarrollé la rutina que solicitaste.
Pero, eventualmente, comento otra solución que podría no haber sido considerada (tampoco podemos saberlo aqui). A veces, es todo lo que se necesita.
Respecto a tu otra consulta aquí te paso una variante donde puedes indicarle desde qué hoja tomar los datos y ello te permitirá ejecutar la rutina desde donde desees.
Sub BuscaDatos()
'---- Variables modificables ----
'=== KARLOS, modifica estos datos de acuerdo a tu proyecto:
HojaOrig = "Hoja1" ' Hoja donde Buscar
RangoBusq = "A7:A5000" ' Rango donde buscar datos
HojaDest = "Hoja2" ' Hoja donde dejar lo encontrado
Celdest1 = "D4" 'celda donde dejar primer dato a la par
Celdest2 = "D8" 'celda donde dejar segundo dato a la par
Celdest3 = "C10" 'celda donde dejar tercer dato a la par
'---- fin Variables
'
'---- inicio de rutina:
'
cont = 0
Buscar = InputBox("ingresar el item a buscar " & Chr(10) & "(Cancelar o dejar en blanco para salir)", "RUTINA DE BUSQUEDA")
If Len(Buscar) Then
On Error Resume Next
Encontrado = Sheets(HojaOrig).Range(RangoBusq).Find(What:=Buscar, LookAt:=xlWhole).Address
If Err.Number = 0 And Len(Encontrado) > 0 Then
Sheets(HojaDest).Range(Celdest1).Value = Sheets(HojaOrig).Range(Encontrado).Offset(0, 1).Value
Sheets(HojaDest).Range(Celdest2).Value = Sheets(HojaOrig).Range(Encontrado).Offset(0, 2).Value
Sheets(HojaDest).Range(Celdest3).Value = Sheets(HojaOrig).Range(Encontrado).Offset(0, 3).Value
cont = 1
End If
Err.Clear
On Error GoTo 0
End If
ElMensaje = IIf(cont = 0, "NO ", "") & "SE ENCONTRO " & IIf(Len(Buscar), Buscar, "<vacio>")
TipoMens = IIf(cont = 0, vbCritical, vbInformation)
ElTitulo = IIf(cont = 0, "NO SE HIZO NADA", "TERMINADO!")
MsgBox ElMensaje, TipoMens, ElTitulo
End Sub
Abrazo
Fer
.
¡Gracias!
Listo ya funciona perfectamente
Muchas gracias
.
OK. Un placer ayudar.
Abrazo
Fer
.
