Este fórum está sendo desativado

[CSoares]

Bom dia a todos

Queria criar uma tabela com dados filtrados, a partir de uma folha 1, onde está a base de dados.
Na folha 1 tenho a base de dados com várias colunas
Na folha 2 tenho uma célula onde selecciono o critério através de uma lista pendente, e uma tabela que sería preenchida com a informação da base de dados.

Por exemplo: Na folha 2 quero uma tabela com uma listagem de todas as "Laranjas"

Em anexo envio um ficheiro para explicar melhor.

Obrigado pela ajuda

[osvaldomp]

Se você quiser experimentar uma solução via macro, então instale uma cópia do código abaixo no módulo da planilha Folha2.

Código: Selecionar todos

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim LR As Long
  If Target.Count > 1 Then Exit Sub
  If Target.Address <> "$C$4" Then Exit Sub
  LR = Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
  If LR > 4 Then Range("F5:O" & LR).Value = ""
  If Target.Value <> "" Then
   With Sheets("Folha1")
    On Error Resume Next
    .ShowAllData
    On Error GoTo 0
    .[A2:K2].AutoFilter 1, Target.Value
    .Range("B3:K" & .Cells(Rows.Count, 1).End(3).Row).Copy
    [F5].PasteSpecial xlValues
    .ShowAllData
   End With
  End If
End Sub

[Deciog]

CSoares , Bom Dia.

Confere se é desta forma que desejas

Se minha resposta foi útil, clique em obrigado é uma forma de agradecimento da ajuda

Decio

[CSoares]

Obrigado, acho que funcionou na perfeição, jamais conseguiria fazer uma fórmula tão grande e complexa

Muito obrigado a todos

[CSoares]

Criei uma macro, copiei o codigo que me enviou, associei a macro a um botão, mas quando corro surge um erro.
Em anexo envio uma imagem para saber onde estou a cometer o erro.
Obrigado

Se você quiser experimentar uma solução via macro, então instale uma cópia do código abaixo no módulo da planilha Folha2.

Código: Selecionar todos

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim LR As Long
  If Target.Count > 1 Then Exit Sub
  If Target.Address <> "$C$4" Then Exit Sub
  LR = Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
  If LR > 4 Then Range("F5:O" & LR).Value = ""
  If Target.Value <> "" Then
   With Sheets("Folha1")
    On Error Resume Next
    .ShowAllData
    On Error GoTo 0
    .[A2:K2].AutoFilter 1, Target.Value
    .Range("B3:K" & .Cells(Rows.Count, 1).End(3).Row).Copy
    [F5].PasteSpecial xlValues
    .ShowAllData
   End With
  End If
End Sub

[osvaldomp]

Instale uma cópia do código no módulo da planilha, assim:

1. copie o código que passei
2. clique com o direito na guia da planilha Folha2 e escolha 'Exibir Código'
3. cole o código na janela em branco que vai se abrir
4. feito! 'Alt+Q' para retornar para a planilha e testar

funcionamento - ao selecionar o critério em C4 da Folha2 e o código irá preencher a tabela; se C4 = vazio então o código irá limpar a tabela

obs. o código está pronto para funcionar, não requer adições e não requer botão, seu funcionamento será automático ao alterar o conteúdo de C4

[CSoares]

Funcionou também na perfeição e a implementação é muito simples, apesar do código ser complexo

Muito obrigado aos dois e pela vossa impressionante ajuda