Remove From My Forums

Preciso de ajuda nesta macro

Pergunta

Entrar para Votar

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

sexta-feira, 6 de janeiro de 2017 11:05

Todas as Respostas