VBA Como salvar em ordem decrescente no banco de dados

Question

Alguém poderia me dar um Help?

Tenho um registro onde são salvos em uma planilha chamada histórico.

So que os registros são salvos em ordem crescente e eu precisaria que fossem em ordem decrescente...ou seja que adicionasse uma linha e salvasse nessa linha... isso eu consigo numa gravação de macro...mas nao consegui adapta-la nesse codigo...entao eu precisaria mudar somente essa parte

ShHLinha = ShH.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row

Exemplo:

Minha lista do Historico começa na linha 6.

Então toda vez que fosse gravar algo no historico adicionasse uma linha e gravasse nela, mas nao estou conseguindo na linguagem do VBA.

Alguem pode me ajudar?

Sub Gravar_Dados()
'Registro

Dim ShC As Worksheet
Dim ShH As Worksheet
Dim ShHLinha As Long

Application.ScreenUpdating = False

If Range("C3").Value = "" Or Range("E3").Value = "" Or Range("C4").Value = "" _
Or Range("B6").Value = "" Or Range("B8").Value = "" Then

    MsgBox "FALTAM O PREENCHIMENTO DOS DADOS INICIAIS"
    Exit Sub
End If


Set ShR = Sheets("Registro")
Set ShH = Sheets("Historico")
Worksheets("Registro").Unprotect ""
Worksheets("Historico").Unprotect ""



ShHLinha = ShH.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row


With ShH

If ShR.Range("B8") = "Construção para Obra" Then
        
    .Cells(ShHLinha, 7).Value = ShR.Range("B12").Value
    .Cells(ShHLinha, 8).Value = ShR.Range("D12").Value
    .Cells(ShHLinha, 9).Value = ShR.Range("B13").Value
    .Cells(ShHLinha, 10).Value = ShR.Range("D13").Value
    
End If

If Range("B8").Value = "Fundação da obra" Then

    .Cells(ShHLinha, 11).Value = ShR.Range("B12").Value
    .Cells(ShHLinha, 12).Value = ShR.Range("D12").Value
    .Cells(ShHLinha, 13).Value = ShR.Range("B13").Value
    .Cells(ShHLinha, 14).Value = ShR.Range("D13").Value
    .Cells(ShHLinha, 15).Value = ShR.Range("B14").Value
    .Cells(ShHLinha, 16).Value = ShR.Range("D14").Value
    .Cells(ShHLinha, 17).Value = ShR.Range("B15").Value
    .Cells(ShHLinha, 18).Value = ShR.Range("D15").Value
    .Cells(ShHLinha, 19).Value = ShR.Range("B16").Value
    .Cells(ShHLinha, 20).Value = ShR.Range("D16").Value
    .Cells(ShHLinha, 21).Value = ShR.Range("B17").Value
    .Cells(ShHLinha, 22).Value = ShR.Range("D17").Value

End If

Range("E2").Value = Range("E2").Value + 1

ActiveWorkbook.Save
Worksheets("Registro").Protect ""
Worksheets("Historico").Protect "" _
, AllowFiltering:=True


Application.ScreenUpdating = True

MsgBox "Dados Gravados Com Sucesso!!!", vbOKOnly, "Cadastro Realizado."

End Sub