Option
Explicit
Sub
Makro1()
Makro2
"Tabelle1"
,
"Tabelle2"
,
"Frankfurt"
,
"a"
, 6000, 34, 15
End
Sub
Sub
Makro2(t1, t2, k1, k2, k3, ic1, ic2)
Dim
c
As
Range
Set
c = Sheets(t1).UsedRange
With
c
.AutoFilter
.AutoFilter Field:=1, Criteria1:=k1
.AutoFilter Field:=2, Criteria1:=k2
.AutoFilter Field:=3, Criteria1:=
">"
&
CStr
(k3), Operator:=xlAnd
c.SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets(t2).Range(c.Cells(1).Address)
c.AutoFilter
End
With
With
Sheets(t2)
For
Each
c
In
.Range(.Range(c.Cells(1).Address).CurrentRegion.Columns(1).Address)
If
c.EntireRow.Row
Mod
2 = 0
Then
Range(c, c.Offset(0, 2)).Interior.ColorIndex = ic1
Else
Range(c, c.Offset(0, 2)).Interior.ColorIndex = ic2
End
If
Next
c
End
With
End
Sub