Solved: Filter Guide on "X" criterion on the "Y" result tab "Z" and "V"

[elsg]

hellow
I need to filter the data tab "BASE" according to the criteria tab "Criterium" (columns "B: C"), paste the data according to the criteria found.

see what I did manually taking data for each tab ("INSTALLING") and ("REMOVE")

[xls]

Hi,

Try this code in VBA
[VBA]Sub Macro1()

Dim rng As Range
Dim cell As Range

Application.ScreenUpdating = False

Sheets("Criteria").Select
'Set rng = Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row)
Set rng = Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
'ActiveCell.Value = rng.Address
For Each cell In rng
Sheets("BASE").Select

With ActiveSheet
.AutoFilterMode = False
.Range("A:E").AutoFilter
.Range("A11").AutoFilter Field:=1, Criteria1:=cell.Value
.Range("A11").AutoFilter Field:=2, Criteria1:=cell.Offset(0, 1).Value
.Range("A11").AutoFilter Field:=4, Criteria1:=cell.Offset(0, 3).Value

End With

Range("A25000").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets(cell.Offset(0, 2).Value).Select
Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Next cell
Application.ScreenUpdating = False
Application.CutCopyMode = False

End Sub
[/VBA]

[xls]

attachment

[p45cal]

In the attached file on the Criteria sheet, there's a button to click.
Before you click it you'll see that sheets INSTALLING and REMOVE are both empty. Clicking the button will not seem to do much but those two sheets will have been populated.
Whether it's what you want or not I really don't know, and with a data base format as you have in the Sheet BASE I wonder whether you'd not be better served with pivot tables.

The code so people don't have to download the file:[VBA]Sub blah()
For Each cll In Sheets("Criteria").Range("C2:C11")
Set DestSht = Sheets(cll.Value)
With DestSht
Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(2)
DestCell.Offset(, 6).Value = "NOME"
DestCell.Offset(, 7).Value = "TIPO"
DestCell.Offset(1, 7).Value = cll.Value
DestCell.Offset(1, 6).Formula = "=""=" & cll.Offset(, -1).Value & """"
Set CritRng = DestCell.Offset(, 6).Resize(2, 2)
Sheets("BASE").Range("A1:E73").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=CritRng, CopyToRange:=DestCell, Unique:=False
CritRng.Clear
End With
Next cll
End Sub[/VBA]

[elsg]

I am very grateful for the help, both answers answered me perfectly!

thank you very much!!