Este fórum está sendo desativado

[tiagotas]

Tenho um banco de dados que me apresenta os silos referentes a cada célula, preciso escolher a célula e posteriormente ela me apresenta apenas os valores desse filtro:



Porém, a minha base de dados tem que ser na mesma planilha, e eu preciso que seja em planilhas diferentes pois quando trato os dados não posso afetar o resultado:

Código: Selecionar todos

Sub Filtro()
'
' Filtro Macro
'
    Columns("A:B").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "E1:F2"), CopyToRange:=Columns("G:H"), Unique:=False
End Sub

Sub Cel1Clique()
'
' Cel1Clique Macro
'
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "CÉLULA 1"
    
    Call Filtro
    
End Sub

Sub Cel2Clique()
'
' Cel1Clique Macro
'
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "CÉLULA 2"
    
    Call Filtro
    
End Sub

Sub Cel3Clique()
'
' Cel1Clique Macro
'
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "CÉLULA 3"
    
    Call Filtro
    
End Sub

Sub Lpo1Clique()
'
' Cel1Clique Macro
'
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "LPO 1"
    
    Call Filtro
    
End Sub

Sub Lpo2Clique()
'
' Cel1Clique Macro
'
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "LPO 2"
    
    Call Filtro
    
End Sub

[alexandrevba]

Boa tarde!!

Vamos considerar que você tem uma guia chamada AleVBA.
Seria algo assim?

Código: Selecionar todos

Sub AleVBA()
    Dim nextrow As Long
    Dim c As Range, rngCriteria As Range
     
    Application.ScreenUpdating = False
    Worksheets("AleVBA").Cells.Clear
    With Plan1
        .AutoFilterMode = False
        Set rngCriteria = Worksheets("Planilha1").Range("E2")
        For Each c In rngCriteria
            nextrow = Worksheets("AleVBA").Cells(Rows.Count, "A").End(xlUp).Row
            .Range("A1:G" & .Cells(Rows.Count, "A").End(xlUp).Row).AutoFilter field:=5, Criteria1:="=" & c.Value
            .Range("A1:G" & .Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy _
            Worksheets("AleVBA").Range("A" & nextrow + 1)
        Next c
    End With
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Att

[tiagotas]

Alexandre, ele apenas filtrou a informação, e não consegui mostrar as informações que selecionei na A1 da AleVBA.

Provavelmente não compreendi o arquivo.

[osvaldomp]

Veja se o arquivo anexo atende.