VBA DE BUSCA

[WAYNEWAVE]

Boa tarde!

Galera preciso de um código que me retorne as informações de uma tabela com base um filtro de data(De[yy/xx/aa] Até[zz/xx/yy]) que está em uma célula do excel.

 

Basicamente é um PROCV... A tabela contém 10 colunas e a data está na segunda.

Eu queria que código traga as informações da Tabela Mãe para uma outra Tabela Filha, baseado nos criterios de data.

 

Alguém pode me ajudar?

[WAYNEWAVE]

2 horas atrás, WAYNEWAVE disse:

Boa tarde!

Galera preciso de um código que me retorne as informações de uma tabela com base um filtro de data(De[yy/xx/aa] Até[zz/xx/yy]) que está em uma célula do excel.

 

Basicamente é um PROCV... A tabela contém 10 colunas e a data está na segunda.

Eu queria que código traga as informações da Tabela Mãe para uma outra Tabela Filha, baseado nos criterios de data.

 

Alguém pode me ajudar?

A foto 1 é a base de dados e a foto 2 é onde eu gostaria que retornasse os valores de acordo com o filtro de data.

[Alyson Ronnan Martins]

Boa noite.

Bem com eu não tenho o nome de suas tabelas eu coloquei da seguinte forma:
Tabela que tem o Valores eu coloquei na "Planilha1"
Tabela que vai aparecer o resumo coloquei na "Planilha2"
e com base nisso aparece o seguinte código:

Public Sub PesquisarFiltro()
Dim DtI As Date, DtF As Date, DtAtual As Date 'Armazena a data
Dim uLinhaTabela As Integer 'Armaze a quantidade de linhas na tabelas de valores
Dim x As Integer 'Mostra em qual linha esta na tabela dos valores
Dim y As Integer 'Conta a quantidade de linhas que esta acrescentando na planilha tual
    
'Limpa a tabela atual
Sheets("Planilha2").Range("A2:F1000").ClearContents

'Captura as datas da planilha atual
DtI = Sheets("Planilha2").Cells(1, "B").Value
DtF = Sheets("Planilha2").Cells(1, "D").Value

'Ultima Linha da tabela com os valores
uLinhaTabela = Sheets("Planilha1").Cells(Rows.Count, "F").End(xlUp).Row

'Usando a função for para passar linha a linha a tabela de valores
'e verificar se as datas batem
y = 2
For x = 2 To uLinhaTabela Step 1
    DtAtual = Sheets("Planilha1").Cells(x, "F").Value
    If DtAtual >= DtI And DtAtual <= DtF Then
        With Sheets("Planilha2")
            .Cells(y, "A").Value = Sheets("Planilha1").Cells(x, "A").Value
            .Cells(y, "B").Value = Sheets("Planilha1").Cells(x, "B").Value
            .Cells(y, "C").Value = Sheets("Planilha1").Cells(x, "C").Value
            .Cells(y, "D").Value = Sheets("Planilha1").Cells(x, "D").Value
            .Cells(y, "E").Value = Sheets("Planilha1").Cells(x, "E").Value
            .Cells(y, "F").Value = Sheets("Planilha1").Cells(x, "F").Value
        End With
        y = y + 1 'Nova linha de cadastro na outra planilha
    End If
Next x
End Sub

Fico no aguardo.