Tópicos relacionados a códigos VBA, gravação de macros, etc.
Por Mablove 29 Jan 2018 às 01:10
Membro Novato
Mensagens: 8
Reputação: 1
#29832
Boa noite gente, preciso muito de ajuda. estou criando uma planilha com algumas atribuições em macro. Milha planilha tem cerca de 4 abas e em 3 delas possuo diversas colunas com diferentes datas. preciso construir uma consulta de datas em todas as abas e nas diversas colunas, que me resulte todos os resultados, se possível uma consulta entre duas datas (inicio e fim) ou um critério em que os resultados possuam mês e ano idênticos o da pesquisa. Já tentei de diversas formas mas não sei como fazer. ME AJUDEM POOOR FAVOOOR


Preciso que a planilha final fique assim:

Produto - Nome da planilha - Lote - Data(que esteja dentro do critério) -
xx xxxx xx xx/xx/yyyy
Apenas usuários registrados podem ver ou baixar anexos.
Editado pela última vez por Mablove em 02 Fev 2018 às 23:11, em um total de 1 vez.
Avatar do usuário
Por alexandrevba 30 Jan 2018 às 11:51
Excel Expert
Mensagens: 1643
Reputação: 578
#29883
Bom dia!!

Segue um esboço para teste!
Agora é só implementar conforme sua necessidade.
Código: Selecionar todosPublic Sub AleVBA_6187()
'https://gurudoexcel.com/forum/viewtopic.php?f=12&t=6187
'Copia baseado em data de várias guias para uma guia resumo
Dim Ws As Worksheet, LR1 As Long, LR2 As Long
Dim lr As Long
Dim dDate1 As Long
Dim dDate2 As Long
Dim wsConsultas As Worksheet
Set wsConsultas = Worksheets("Consultas")
'Encontra a ultima linha de cada guia
lr = wsConsultas.UsedRange.Rows(UBound(wsConsultas.UsedRange.Value)).Row
'Verifica quais as datas como critério
dDate1 = DateValue(Format(wsConsultas.Range("O1"), "dd/mm/yyyy")) 'Digite a data Incial nesta célula
dDate2 = DateValue(Format(wsConsultas.Range("P1"), "dd/mm/yyyy")) 'Digite a data Final nesta célula
'Desliga a tela de atualização
Application.ScreenUpdating = False
'Limpa as células da guia para onde os dados são copiados
    With wsConsultas.Range(Cells(2, 1), Cells(lr, 12))
        .ClearContents
    End With
'Copia os dados das guias para a guia Consulta
    For Each Ws In ThisWorkbook.Worksheets
         If Ws.Name <> "Menu" And Ws.Name <> "Consultas" Then
            LR1 = ThisWorkbook.Worksheets("Consultas").Range("A" & Rows.Count).End(xlUp).Row + 1
            LR2 = Ws.Range("A" & Rows.Count).End(xlUp).Row
            ThisWorkbook.Worksheets("Consultas").Range("L" & LR1).Resize(LR2 - 1).Value = Ws.Name
            Ws.Range("A2:L" & LR2).Copy ThisWorkbook.Worksheets("Consultas").Range("A" & LR1)
         End If
     Next Ws
'Filtra os dados
    With wsConsultas
        .AutoFilterMode = False
        With .Range("A1:L1")
            .AutoFilter
            .AutoFilter Field:=4, Criteria1:=">=" & dDate1, Operator:=xlAnd, Criteria2:="<=" & dDate2
        End With
    End With
Application.ScreenUpdating = True
End Sub

Att
Avatar do usuário
Por alexandrevba 05 Fev 2018 às 10:03
Excel Expert
Mensagens: 1643
Reputação: 578
#30020
Bom dia!!

Se você verificou meu post anterior, eu disse favor adaptar!!

Preencha suas guias com dados, pois o código verifica o total de linhas de cada um das guias que precisa ser copiadas. Eu volto a dizer, favor adaptar!!!!!!!!!

Att
Apenas usuários registrados podem ver ou baixar anexos.