Hacer Búsquedas de Datos
Hola que Tal. Quisiera que me ayudara con esto.
Lo que quiero es crear una macro donde se puede buscar un dato especifico en una hoja de Calculo que contiene información de Empleados, que al ejecutar un botón me pida ingresar el código a buscar y luego al encontrarlo 1ero. Seleccione el código y el rango de datos(Hacia la Derecha) que pertenecen a ese código y lo copie a otra hoja de datos de exempleados para tener un Historial y luego elimine estos datos de la hoja principal, si no encuentra el código me presente el mensaje de que el código no existe.
El objetivo es que tenemos una hoja de excel con información de empleados y al dejar de laborar el empleado se elimine de esta hoja y automáticamente pase a otra hoja para mantener un Historial de Exempleados.
Nota: al encontrar el código se debe seleccionar un rango de celdas hacia la derecha (Aproximadamente 8 Celdas Hacia la derecha) No toda la Fila.
Agradecería pronta respuesta.
Lo que quiero es crear una macro donde se puede buscar un dato especifico en una hoja de Calculo que contiene información de Empleados, que al ejecutar un botón me pida ingresar el código a buscar y luego al encontrarlo 1ero. Seleccione el código y el rango de datos(Hacia la Derecha) que pertenecen a ese código y lo copie a otra hoja de datos de exempleados para tener un Historial y luego elimine estos datos de la hoja principal, si no encuentra el código me presente el mensaje de que el código no existe.
El objetivo es que tenemos una hoja de excel con información de empleados y al dejar de laborar el empleado se elimine de esta hoja y automáticamente pase a otra hoja para mantener un Historial de Exempleados.
Nota: al encontrar el código se debe seleccionar un rango de celdas hacia la derecha (Aproximadamente 8 Celdas Hacia la derecha) No toda la Fila.
Agradecería pronta respuesta.
Respuesta de fejoal
1
Cuando veas el código siguiente, tal vez entiendas la demora...
Abre tu editor de visual basic en el archivo donde esta tu base de empleados y pega el siguiente código en un módulo nuevo:
Sub BajaEmpl()
Dim COD2search
Dim rang2search As Range
'=== Cesar, ingresa aquí los parámetros de tu archivo
RangoBusqueda = "B:B" 'Columna o rango donde están los códigos en la hoja activa
HojaDestino = "ExEmpleados" ' Hoja que recibirá los datos
PrimCelda = "B2" 'Primer celda en la Hoja destino a partir de la cual empieza el listado (Probablemente tenga el titulo código)
CantCeldas = 9 'Celdas a llevar a la tabla contando también la de código
'========================
Set rang2search = Range(RangoBusqueda)
88: COD2search = InputBox("Ingrese Código de persona a transferir", "PASE a EX EMPLEADOS")
If Len(COD2search) = 0 Then
M_Tit = "FALTA CODIGO"
M_Mens = "Al no ingresar código, proceso termina aquí"
MsgBox M_Mens, vbInformation, M_Tit
Else
Set EnCelda = rang2search.Find(COD2search, LookIn:=xlValues)
If Not EnCelda Is Nothing Then
EnCelda.Select
Set TransRNG = Range(Selection, EnCelda.Offset(0, CantCeldas - 1))
TransRNG.Interior.ColorIndex = 6
OrigSheet = ActiveSheet.Name
M_Tit = "CONFIRME TRANSFERENCIA"
M_Mens = "El registro marcado será transferido" & Chr(10) & "a la base de Ex Empleados." & Chr(10) & "Acepte o Cancele"
GOON = MsgBox(M_Mens, vbOKCancel, M_Tit)
TransRNG.Interior.ColorIndex = xlNone
If GOON = vbOK Then
'pasaje de datos
TransRNG.Copy
Sheets(HojaDestino).Select
Range(PrimCelda).Select
ActRow = Range(PrimCelda).CurrentRegion.Rows.Count
Range(PrimCelda).Offset(ActRow).Select
Selection.PasteSpecial Paste:=xlValues
Selection.PasteSpecial Paste:=xlFormats
Range(PrimCelda).Offset(ActRow).Select
Application.CutCopyMode = False
Sheets(OrigSheet).Select
TransRNG.Delete Shift:=xlUp
M_Tit = "PROCESO TERMINADO"
M_Mens = "El código " & COD2search & " fue transferido a la base de Ex-empleados"
MsgBox M_Mens, vbInformation, M_Tit
Else
M_Tit = "PROCESO INTERRUMPIDO"
M_Mens = "NO se transfieren datos a la base de Ex-empleados, proceso termina aquí"
MsgBox M_Mens, vbInformation, M_Tit
End If
Else
M_Tit = "CODIGO INEXISTENTE"
M_Mens = "El código " & COD2search & " no existe en la base. Ingrese otro"
MsgBox M_Mens, vbExclamation, M_Tit
GoTo 88
End If
End If
End Sub
Verás al inicio que tienes un área para escribir las direcciones específicas de tu archivo. Cambialas y luego cierra el editor.
Desde la hoja de empleados, ejecuta la macro BajaEmpl.
Esta hace lo que solicitabas en su totalidad. Además agrega un par de controles y alguna sutilezas.
Espero que te satisfaga.
Si así fuera, ya sabes...
Un gran abrazo!
Fernando
Abre tu editor de visual basic en el archivo donde esta tu base de empleados y pega el siguiente código en un módulo nuevo:
Sub BajaEmpl()
Dim COD2search
Dim rang2search As Range
'=== Cesar, ingresa aquí los parámetros de tu archivo
RangoBusqueda = "B:B" 'Columna o rango donde están los códigos en la hoja activa
HojaDestino = "ExEmpleados" ' Hoja que recibirá los datos
PrimCelda = "B2" 'Primer celda en la Hoja destino a partir de la cual empieza el listado (Probablemente tenga el titulo código)
CantCeldas = 9 'Celdas a llevar a la tabla contando también la de código
'========================
Set rang2search = Range(RangoBusqueda)
88: COD2search = InputBox("Ingrese Código de persona a transferir", "PASE a EX EMPLEADOS")
If Len(COD2search) = 0 Then
M_Tit = "FALTA CODIGO"
M_Mens = "Al no ingresar código, proceso termina aquí"
MsgBox M_Mens, vbInformation, M_Tit
Else
Set EnCelda = rang2search.Find(COD2search, LookIn:=xlValues)
If Not EnCelda Is Nothing Then
EnCelda.Select
Set TransRNG = Range(Selection, EnCelda.Offset(0, CantCeldas - 1))
TransRNG.Interior.ColorIndex = 6
OrigSheet = ActiveSheet.Name
M_Tit = "CONFIRME TRANSFERENCIA"
M_Mens = "El registro marcado será transferido" & Chr(10) & "a la base de Ex Empleados." & Chr(10) & "Acepte o Cancele"
GOON = MsgBox(M_Mens, vbOKCancel, M_Tit)
TransRNG.Interior.ColorIndex = xlNone
If GOON = vbOK Then
'pasaje de datos
TransRNG.Copy
Sheets(HojaDestino).Select
Range(PrimCelda).Select
ActRow = Range(PrimCelda).CurrentRegion.Rows.Count
Range(PrimCelda).Offset(ActRow).Select
Selection.PasteSpecial Paste:=xlValues
Selection.PasteSpecial Paste:=xlFormats
Range(PrimCelda).Offset(ActRow).Select
Application.CutCopyMode = False
Sheets(OrigSheet).Select
TransRNG.Delete Shift:=xlUp
M_Tit = "PROCESO TERMINADO"
M_Mens = "El código " & COD2search & " fue transferido a la base de Ex-empleados"
MsgBox M_Mens, vbInformation, M_Tit
Else
M_Tit = "PROCESO INTERRUMPIDO"
M_Mens = "NO se transfieren datos a la base de Ex-empleados, proceso termina aquí"
MsgBox M_Mens, vbInformation, M_Tit
End If
Else
M_Tit = "CODIGO INEXISTENTE"
M_Mens = "El código " & COD2search & " no existe en la base. Ingrese otro"
MsgBox M_Mens, vbExclamation, M_Tit
GoTo 88
End If
End If
End Sub
Verás al inicio que tienes un área para escribir las direcciones específicas de tu archivo. Cambialas y luego cierra el editor.
Desde la hoja de empleados, ejecuta la macro BajaEmpl.
Esta hace lo que solicitabas en su totalidad. Además agrega un par de controles y alguna sutilezas.
Espero que te satisfaga.
Si así fuera, ya sabes...
Un gran abrazo!
Fernando
Esta Excelente, lo único que cuando lleva los Datos a la Hoja ExEmpleados me reemplaza el anterior pero creo que yo puedo Solucionar eso, le Agradesmo Mucho su Ayuda, Mil Gracias.
