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!