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
|