Boa noite, pessoal

Escrevi um código que insere o registro mais recente sempre no topo de uma tabela (TB_Pacientes) e busca sempre o maior número de registro na coluna cadastro, acrescido de +1, para inserir o novo registro com esse número .
Feito isso o código executa a rotina descrita abaixo que foi feita com a ajuda do gravador de macros.

Parte do código:

tabela.Sort. _
        SortFields.Clear
    tabela.Sort. _
        SortFields.Add Key:=Range("TB_Pacientes[[#All],[Data]]"), SortOn:= _
        xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
    With tabela.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Range("TB_Pacientes[Cadastro]").FormulaR1C1 = _
        "=LIN()-LIN(TB_Pacientes[[#Cabeçalhos],[Cadastro]])"
    Range("TB_Pacientes[Cadastro]").Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    tabela.Sort. _
        SortFields.Clear
    tabela.Sort. _
        SortFields.Add Key:=Range("TB_Pacientes[[#All],[Data]]"), SortOn:= _
        xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    
    With tabela.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Range("TB_Pacientes[Nome]").Select
    tabela.Sort.SortFields.Clear
    tabela.Sort. _
        SortFields.Add Key:=Range("TB_Pacientes[[#All],[Nome]]"), SortOn:= _
        xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
    With tabela.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    tabela.Sort.SortFields.Clear
    tabela.ListRows(1).Range(1, 1).Select
    Application.CutCopyMode = False
    
    Set tabela = Nothing

Basicamente o que ele faz é apagar os valores da coluna de cadastros, colocar em ordem ascendente (menor para o maior) os registros da tabela conforme a data, renumerar os registros usando a fórmula =LIN()-LIN(valor da linha anterior), organizar novamente em forma descendente (conforme a data de registro) e no final organizar em ordem alfabética de A-Z.

Tudo isso para que os registros mais recentes fiquem no topo da tabela e recebam número de cadastro de forma crescente e ao final organize o nome dos pacientes na sequencia alfabética.

Enfim... o código apresenta muitas repetições de comando (como disse foi realizado com o gravador de macros). Há como resumir ou há uma maneira melhor de fazer essa rotina:
- Registros mais recentes recebem números maiores e devem ficar no topo da tabela.

Obrigado a quem puder ajudar.