Excel Como transferir dados de varias abas de uma planilha com critério no vba

[Lucia Andrade]

Olá pessoal, gostaria que me ajudassem se possível.

Preciso de um código que pesquise vária abas ao  mesmo tempo com crítério. A planilha tem com 4 abas . A primeira (Pesquisa) e as outras com Dados1,Dados2,Dados3 , em cada uma tem o cabeçalho com:Data - Produto - valor - cliente e Planilha.Nesta última gostaria que fosse adicionado o nome da aba. Esta macro funciona, só não consegui acrescentar a pesquisa de outras abas.Estou enviado o anexo da planilha e vou colocar o código que fiz. Ficarei muito agradecida.

A pesquisa é feita por critério, no caso pelo nome do cliente.

 

Sub RetânguloCantosArredondados1_Clique()
Dim Lin As Integer, Linha As Long, Linha2 As Integer

Lin = 6        'Referente a linha abaixo do cabeçalho da planilha1(Pesquisa)
Linha = 2       'Referente a linha abaixo do cabeçalho da planilha2(Dados)

Planilha1.Range("A6:E10000").ClearContents
With Planilha2
Do Until .Cells(Linha, 1) = ""
If InStr(1, UCase(.Cells(Linha, 4)), UCase(Planilha1.Range("B3"))) Then 

Planilha1.Activate
Planilha1.Cells(Lin, 1) = .Cells(Linha, 1).Value
Planilha1.Cells(Lin, 2) = .Cells(Linha, 2).Value
Planilha1.Cells(Lin, 3) = .Cells(Linha, 3).Value
Planilha1.Cells(Lin, 4) = .Cells(Linha, 4).Value
Lin = Lin + 1      
End If

Linha = Linha + 1

Loop
End With

End Sub

 

 

Grata

Lucia Andrade

 

 

PLANILHA ENVIADA PARA O CLUBE O HARDWARE.xlsx

[OreiaG]

Olá, @Lucia Andrade.

Veja se o código abaixo faz o que você deseja.

Antes de testar altere os cabeçalhos das planilhas DADOS-2 e DADOS-3 e deixe iguais à planilha DADOS, ou seja, com o cabeçalho na linha 1.

Sub RetânguloCantosArredondados1_Clique()
 Dim cliente As String, ws As Worksheet, x As Long
  With Sheets("PESQUISA")
   cliente = .[B3]
   If .[A6] <> "" Then .Range("A6:E" & .Cells(Rows.Count, 1).End(3).Row).ClearContents
   For Each ws In Worksheets(Array("DADOS", "DADOS-2", "DADOS-3"))
    ws.AutoFilterMode = False
    ws.[A1:D1].AutoFilter 4, cliente
    x = ws.AutoFilter.Range.Columns(1).SpecialCells(12).Count
    If x > 1 Then
     ws.Range("A2:D" & ws.Cells(Rows.Count, 1).End(xlUp).Row).Copy .Cells(Rows.Count, 1).End(3)(2)
     .Cells(Rows.Count, 5).End(3)(2).Resize(x - 1) = ws.Name
    End If
    ws.AutoFilterMode = False
   Next ws
 End With
End Sub

 

obs. se você quiser o código poderá ser ajustado para ser executado sempre que for alterado o nome em PESQUISA!B3, sem a necessidade de clicar na figura Retângulo.

[Lucia Andrade]

Obrigada! Perfeito funcionou do jeito que eu queria.

@OreiaG Desculpa fiquei tão ansiosa em testar ,que não vi sua observação abaixo:"obs. se você quiser o código poderá ser ajustado para ser executado sempre que for alterado o nome em PESQUISA!B3, sem a necessidade de clicar na figura Retângulo"

Dessa foma como é feita essa alteração? outra dúvida , caso mude o nome das abas o código ainda funciona?

 

[OreiaG]

8 horas atrás, Lucia Andrade disse:

Dessa foma como é feita essa alteração?

Instale o código abaixo que já está com as alterações.

 

outra dúvida , caso mude o nome das abas o código ainda funciona?

Não irá funcionar. Se a alteração dos nomes ocorrerá uma única vez, então altere os nomes no código. Mas se os nomes são alterados com frequência ou se você trabalha com arquivos em que os nomes sempre são diferentes, aí é possível em lugar dos nomes colocar no código a posição das guias da planilhas, ou seja, pelo índice delas. Por exemplo, no arquivo que você anexou, a planilha PESQUISA tem o índice 1, a planilha DADOS tem o índice 2.

Nesse caso, você precisa informar se a planilha PESQUISA sempre será a primeira à esquerda, índice 1, o nome dela não importa, e se todas as demais deverão ser pesquisadas.

 

 

O código abaixo deve ser instalado no módulo da planilha PESQUISA . Para exibir o módulo clique com o direito na guia da planilha e selecione Exibir Código.

O código será executado ao efetuar manualmente alguma alteração em PESQUISA!B3. Se B3 estiver vazia ou com nome não existente nas planilhas pesquisadas, a tabela ficará vazia.

 

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim ws As Worksheet, x As Long
  If Target.Address <> "$B$3" Then Exit Sub
  With Me
   If .[A6] <> "" Then .Range("A6:E" & .Cells(Rows.Count, 1).End(3).Row).ClearContents
   If Target.Value <> "" Then
    For Each ws In Worksheets(Array("DADOS", "DADOS-2", "DADOS-3"))
     ws.AutoFilterMode = False
     ws.[A1:D1].AutoFilter 4, Target.Value
     x = ws.AutoFilter.Range.Columns(1).SpecialCells(12).Count
     If x > 1 Then
      ws.Range("A2:D" & ws.Cells(Rows.Count, 1).End(xlUp).Row).Copy .Cells(Rows.Count, 1).End(3)(2)
      .Cells(Rows.Count, 5).End(3)(2).Resize(x - 1) = ws.Name
     End If
     ws.AutoFilterMode = False
    Next ws
   Else: Exit Sub
   End If
 End With
End Sub

 

[Lucia Andrade]

Perfeito,Obrigada.

 

Sem querer abusar, Esse código,se eu mudar algum nome da planilha ele vai funcionar?

Gratidão ,Gratidão

Lucia Andrade

[Midori]

Em 20/01/2024 às 20:36, Lucia Andrade disse:

só não consegui acrescentar a pesquisa de outras abas.

Para isso faltou fazer o loop nas abas. Esse pode ser um For Each mais externo ao das linhas. p.ex,

 

For Each Planilha In ThisWorkbook.Sheets
    Linha = 2       'Referente a linha abaixo do cabeçalho da planilha2(Dados)
    If Left(Planilha.Name, 4) = "DADO" Then
        With Planilha
            Do Until .Cells(Linha, 1) = ""
...

 

[OreiaG]

1 hora atrás, Lucia Andrade disse:

Esse código,se eu mudar algum nome da planilha ele vai funcionar?

 

Não irá funcionar. Veja os comentários que fiz no post #4.

[Lucia Andrade]

Obrigada pela atençao, me ajram bastante

[DJunqueira]

Tb tem a possível solução com o Power Query (ferramenta nativa do Excel) q você pode usar p/ fazer o q você quer sem uso de macro.

 

Acrescentaria ainda q uma coisa é armazenar dados e outra é visualizar/filtrar, você não precisaria de tantas abas p/ armazenar dados compatíveis, o ideal seria armazenar tudo numa tabela p/ depois visualizar e filtrar como você quiser.

Solução com Power Query.xlsx

[Lucia Andrade]

Obrigada pela dica, vou olhar, não sei nada sobre power query

Lucia Andrade

[DJunqueira]

É uma ferramenta bem interessante e faz muitas coisas q o VBA faz sem tanto código.