¿Cómo ordenar de forma personalizada mediante macro?

[Christian Wise]

Buenos días,

actualmente estoy trabajando con un archivo para crear una solución para la gestión de recibos impagados. Tengo todo listo (algo básico, debido a mi nivel) pero me encuentro con el siguiente problema:

Al intentar ordenar el listado original mediante las distintas opciones de Excel solamente consigo ordenar mediante la Fecha de Vencimiento o mediante el Nombre. Si intento ordenar primero por uno y luego por otro, prevalece mas uno siempre. Lo que yo necesitaría es que los recibos con la fecha de vencimiento mas antigua se situasen al inicio de la tabla para ser gestionados primero, pero si un cliente tiene mas de un recibo, este estuviera en la fila inmediatamente inferior, independientemente de la fecha de vencimiento de esos recibos.

Os adjunto un archivo con dos hojas con ejemplos ficticios , en la primera la tabla original y en la segunda hoja la tabla como debería quedar ordenada (la he hecho de forma manual).

Agradezco de antemano cualquier ayuda y disculpad la molestia.

Un saludo.

MacroOrdenar.xlsx

[Antoni]

Interesante problema, cuando tenga un ratito le echo un vistazo, en cualquier caso, va a tener que ser con macros.

[JSDJSD]

Dejo una posible solución

MacroOrdenar.xlsm

[JSDJSD]

Private Sub CommandButton1_Click(): Application.ScreenUpdating = False

With Hoja2
    .Range("A:E").Sort Key1:=.Columns("E"), Order1:=xlAscending, _
                                            Header:=xlYes
    .Range("A:A").AdvancedFilter 2, , .Range("j1"), 1
End With
    Hoja1.Range("A2").CurrentRegion.Clear

    For cont = 2 To Hoja2.Range("J" & Rows.Count).End(xlUp).Row
        persona = Hoja2.Cells(cont, 10)
        With Hoja2.Range("a1").CurrentRegion
            .AutoFilter 1, persona
            ufordenado = Hoja1.Range("A" & Rows.Count).End(xlUp).Row
            If cont = 2 Then
                .SpecialCells(12).Copy Hoja1.Range("A1")
            Else
                .SpecialCells(12).Copy Hoja1.Range("A" & ufordenado + 1)
                Hoja1.Cells(ufordenado + 1, 2).EntireRow.Delete
            End If
            .AutoFilter
        End With
    Next cont
    Hoja2.Range("J:J").Delete

End Sub