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(3).Address)
If IsNumeric(c.Value) Then
If c.Value Mod 2 = 0 Then
c.Interior.ColorIndex = ic1
Else
c.Interior.ColorIndex = ic2
End If
End If
Next c
End With
End Sub
|