Página 1 de 1

Copiar Informações de uma ABA para outra com critério

Enviado: 25 Set 2018 às 13:10
por boncompani
Bom dia pessoal,
Novamente precisando da ajuda de vocês!

Para entendimento:
Eu tenho uma planilha que controlo vencimentos de AETS para os veículos da Usina onde eu trabalho. Nesta planilha, existem diversos hiperlinks que levam a cada tipo de licença e suas respectivas datas de vencimento. Ao lado da data, por estética, foi colocada uma fórmula bem simples para me retornar diversos casos.

Como esta minha planilha:
Tenho vencimentos nas planilhas ‘Prancha’ / ‘Rodotrem’ / ‘Treminhao’ / ‘Carga Seca’ / ‘Vinhaça’ / ‘Rodomuda’, etc (TUDO ANTES DE “MENU REBOQUE”. Em cada aba desta planilha, há diversos veículos que representam cada tipo de licença, COM SUA RESPECTIVA DATA DE VENCIMENTO, e a observação da Formula ‘se’ mencionada acima.

O que eu preciso:
Preciso que dentro destas abas, todos os itens que na coluna “Status (M)” for diferente de “Vigente”, copie a linha completa para a aba “Controle de Vencimentos”.

Gostaria de fazer através de VBA, visto que com QUERY eu não entendo nada!

É possível fazer isso?

Desde já agradeço a ajuda de vocês!
Abraços,
Caio F. Boncompani

Re: Copiar Informações de uma ABA para outra com critério

Enviado: 26 Set 2018 às 16:09
por boncompani
Pessoal, alguém ao menos consegue “dar uma
Luz” de como fazer, para que eu corra atras embasado em algo??

Re: Copiar Informações de uma ABA para outra com critério

Enviado: 26 Set 2018 às 18:03
por osvaldomp
Experimente:

Código: Selecionar todos
Sub ReplicaNãoVigentes()
 Dim wso As Worksheet, wsd As Worksheet, LR As Long
  Set wsd = Sheets("Controle de Vencimentos")
   LR = Application.Max(2, wsd.Cells(Rows.Count, 1).End(3).Row)
   Application.ScreenUpdating = False
   wsd.Range("A2:M" & LR).Value = ""
    For Each wso In Sheets(Array("Carga Seca", "Ônibus", "Prancha", "Rodomuda", _
       "Rodotorta", "Rodotrem", "Treminhão", "Treminhão Transbordo", "Vinhaça"))
     With wso
      .AutoFilterMode = False
      LR = .Cells(Rows.Count, 1).End(3).Row
      If Application.CountIf(.Range("M7:M" & LR), "<>" & "VIGENTE") > 0 Then
       .Range("A6:M" & LR).AutoFilter 13, "<>VIGENTE"
       .Range("A7:M" & LR).Copy
       wsd.Cells(Rows.Count, 1).End(3)(2).PasteSpecial xlValues
       .AutoFilterMode = False
      End If
     End With
    Next wso
   Application.ScreenUpdating = True
End Sub
obs. as linhas vazias no resultado são em consequência das linhas vazias existentes na tabela da planilha Prancha.