none
VBA Como salvar em ordem decrescente no banco de dados RRS feed

  • Pergunta

  • 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
    
    
    
    
    
    


    quinta-feira, 4 de julho de 2019 22:02