none
Ajudaaaa RRS feed

  • Pergunta

  • Bom dia,

    Preciso de uma ajudinha!

    Tenho um relatório do trabalho que sempre faço duas vezes ao mês 15 e 30, e esse relatório possui uma macro de colar dados.

    Gostaria de saber se tem alguma forma de quando eu rodar a macro no dia 30 não apague as informações do dia 15.

    São três bases que colo nesse relatório(Criados, Resolvidos e Eventos).

    Segue como está a macro atualmente.

    Sub Atualizar_Bases()
    
    ' Limpar os dados
        
        Sheets("Base Eventos").Select
        ActiveSheet.Range("$A$1:$D$2307").AutoFilter Field:=1
    
        Application.Calculation = xlAutomatic
        Application.ScreenUpdating = False
        
        Selection.AutoFilter
        Range("B2:D9000").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.ClearContents
        Range("A3").Select
        Range(Selection, Selection.End(xlDown)).Select
       Selection.ClearContents
        
        Sheets("Base Criados").Select
        Range("A2:S3000").Select
        Selection.ClearContents
        Range("A1").Select
        
        Sheets("Base Resolvidos").Select
        Range("A2:S3000").Select
        Selection.ClearContents
        Range("A1").Select
         
        Sheets("Base Eventos").Select
        
        
        
        Application.ScreenUpdating = False
    
    
    
    'Selecionar base para cópia e cola
    
    
    Workbooks.Open (Environ$("USERPROFILE") & "\Desktop\Criados.xlsx")
    Columns("A:A").Select
      
        
        Range("A2:S2").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Windows("Elaboração Dashboard" & ".xlsm").Activate
        Sheets("Base Criados").Select
        Range("vazio").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("T2:X2").AutoFill Destination:=Range("T2:X" & Cells(Rows.Count, 5).End(xlUp).Row)
        
     Windows("Criados.xlsx").Activate
        ActiveWorkbook.Close savechanges:=False
    
    
       Workbooks.Open (Environ$("USERPROFILE") & "\Desktop\Resolvidos.xlsx")
    Columns("A:A").Select
      
        Range("A2:S2").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Windows("Elaboração Dashboard" & ".xlsm").Activate
        Sheets("Base Resolvidos").Select
        Range("A2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("T2:X2").AutoFill Destination:=Range("T2:X" & Cells(Rows.Count, 5).End(xlUp).Row)
     
     Windows("Resolvidos.xlsx").Activate
        ActiveWorkbook.Close savechanges:=False
    
    
    Workbooks.Open (Environ$("USERPROFILE") & "\Desktop\Eventos.xlsx")
    Columns("A:A").Select
      
        Range("A2:C2").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Windows("Elaboração Dashboard" & ".xlsm").Activate
        Sheets("Base Eventos").Select
        Range("B2").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("A2").AutoFill Destination:=Range("A2:A" & Cells(Rows.Count, 3).End(xlUp).Row)
     
     Windows("Eventos.xlsx").Activate
        ActiveWorkbook.Close savechanges:=False
        
        
     ActiveWorkbook.RefreshAll
    
    'Mensagem de finalização
    
    Dim MSG
      
    MSG = MsgBox("Bases atualizadas!", vbInformation, "Done...")
    
    
        
    End Sub
    


    quarta-feira, 4 de janeiro de 2017 12:26

Todas as Respostas