Este fórum está sendo desativado

[marcoenz]

Prezados, eu novo no vba, mas já consegui criar o seguinte código abaixo, porém eu estou achando que tem muitas linhas, alguém tem alguma ideia de como resumir isso, deixar com menos linhas sem perder a funcionalidade, alguma forma mais inteligente de realizar o processo?

estou enviando as planihas para testes

desde já agradeço.

Código: Selecionar todos

Sub atualizar_base_de_dados()

    
    Dim c As Object
    Dim bd As Object
    
    Application.ScreenUpdating = False
    
    Set c = Workbooks.Open("C:\Users\Marquinho\Documents\planilhas\carteira de vendas.xlsm")
    
    Set bd = Workbooks.Open("C:\Users\Marquinho\Documents\planilhas\BASE DE DADOS.xlsx")
    
   Workbooks.Open ("C:\Users\Marquinho\Documents\planilhas\carteira de vendas.xlsm")
    
    Range("b3:d6000").Copy
    
    Workbooks.Open ("C:\Users\Marquinho\Documents\planilhas\BASE DE DADOS.xlsx")
       
    Range("B5").PasteSpecial
    
    Application.CutCopyMode = False
    Range("b4").Select
    

    Range(Selection, Selection.End(xlDown)).Select
    Range("B4:E8000").Select
    ActiveWorkbook.Worksheets("base").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("base").Sort.SortFields.Add2 Key:=Range("B4:B8000"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("base").Sort
        .SetRange Range("B5:E8000")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("B4").Select
    
    bd.Save
    bd.Close
 
 
 Workbooks.Open ("C:\Users\Marquinho\Documents\planilhas\carteira de vendas.xlsm")
    
    
    Sheets("vendas").Select
    Range("B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("B2:D8000").Select
    ActiveWorkbook.Worksheets("vendas").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("vendas").Sort.SortFields.Add2 Key:=Range("B2:B8000") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("vendas").Sort
        .SetRange Range("B3:D8000")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("B2").Select
    
    ActiveWorkbook.Save
    
    MsgBox "Base atualizada com sucesso", vbInformation, "Aviso"
    
End Sub