Seleccionar valores de un rango

Tengo estos datos en una hoja.

Necesito una macro que tome solo el primer y último dato de cada día, que corresponden a la hora de entrada y salida y los pegue en una hoja nueva por día.

1 Respuesta

Respuesta
1

Confunde un poco el color, ya que según tu solicitud debiera pasarse para el día 12 la que dice 7:20:30 y la última sería 6:27:47... ¿es correcto?

Además aclara si las hojas ya están creadas (en ese caso si se llaman 12, 13, etc) y a partir de qué celda se pegarán estos datos.

O mejor enviame una muestra para poder trabajar sobre tu mismo libro. Mis correos aparecen en la portada de mi sitio que dejo al pie.

Buen día.

Le escribí a uno de sus correos adjuntando el archivo en el que estoy trabajando.

Agradezco su ayuda.

Recibido, pero no tienes que valorar antes de recibir respuesta o solución, seguramente será algo mejor que solo 'buena' ;)

Sdos!

Muchísimas gracias. Excelente respuesta. Mejor de lo que esperaba.

Dejo aquí explicada la idea.

Se parte de una hoja según modelo. El proceso crea las hojas diarias y vuelca allí todos los registros del día.

Para ello se ordena la hoja por día-usuario-horas y al finalizar vuelve a dejar la hoja con el orden original.

Dim filx As Long    'fin de rango en hoja Registro
Dim fily As Long    'filas ocupadas en hojas diarias
Dim ho1             'hoja nueva
Dim diax As Integer  'nombre para la hoja creada
Sub pase_de_hojas()
'x Elsamatilde
'se crea una hoja por día. Si ya existe hoja con ese nombre se avisa y no se la crea (*)
'si no hay datos cancela
Sheets("Registro").Select
If [A2] = "" Then Exit Sub
Application.ScreenUpdating = False
'Set hox = Sheets("Registro")
'se ordena por fecha-UserID-Time
Call ordenar
'se recorre hoja guardando menor y mayor tiempo x usuario
usua = [B2].Value
diax = Day([G2])
horx = [H2]
Call nuevaHoja
'se posiciona para empezar
[G3].Select
While ActiveCell.Row <= filx
If Day(ActiveCell) = diax Then
    If Range("B" & ActiveCell.Row) = usua Then
        'ActiveCell.Offset(1, 0).Select
    Else
        'cambio de usuario, = dia, pasa el registro inicio-fin
        Range("A" & ActiveCell.Row - 1 & ":G" & ActiveCell.Row - 1).Copy Destination:=ho1.Range("A" & fily)
        'la 1er hora es la guardada, la última es la del reg anterior
        ho1.Range("H" & fily) = horx
        ho1.Range("I" & fily) = Range("H" & ActiveCell.Row - 1)
        ho1.Range("H" & fily & ":I" & fily).NumberFormat = "h:mm:ss am/pm"
        'ult col - opcional
        ho1.Range("J" & fily) = Range("I" & ActiveCell.Row - 1)
        fily = fily + 1
        'guarda los valores de este nuevo registro - el día es el mismo
        usua = Range("B" & ActiveCell.Row)
        horx = Range("H" & ActiveCell.Row)
    End If
Else
    'cambio de dia - debo pasar el último registro anterior
        Range("A" & ActiveCell.Row - 1 & ":G" & ActiveCell.Row - 1).Copy Destination:=ho1.Range("A" & fily)
        'la 1er hora es la guardada, la última es la del reg anterior
        ho1.Range("H" & fily) = horx
        ho1.Range("I" & fily) = Range("H" & ActiveCell.Row - 1)
        'ult col - opcional
        ho1.Range("J" & fily) = Range("I" & ActiveCell.Row - 1)
        'guarda los valores de este nuevo registro
        usua = Range("B" & ActiveCell.Row)
        horx = Range("H" & ActiveCell.Row)
        diax = Day(Range("G" & ActiveCell.Row))
        Call nuevaHoja
End If
'pasa a fila siguiente
ActiveCell.Offset(1, 0).Select
Wend
'terminó el pase - vuelve a dejar la hoja en el orden presentado
Call volverOrden
MsgBox "Fin del proceso."
End Sub

Sdos!

Buen día, ahora presento un nuevo requerimiento para el mismo proceso, necesito que todo lo de las hojas que se crean cada día aparerezca además en una sola hoja como un consolidado, es decir que en una sola hoja (resumen) me copie lo de todas las hojas y luego si las separe por días.

Muchas gracias.

Con mucho gusto, pero inicia una nueva consulta en el tablón con título: Armar un consolidado y en el cuerpo del mensaje indica que es Para Elsa... y lo que quieras aclarar.

¿Puedo trabajarlo desde tu libro o si tuvo muchos cambios enviamelo nuevamente.?

Sdos!

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas