Private Sub CommandButton1_Click()
Dim boFund As Boolean
Dim loLetzte As Long
Dim OrtA, OrtB, OrtC, OrtD As String
Dim praemieA, praemieB, praemieC, praemieD As String
Application.ScreenUpdating = False
With Worksheets("Blatt1")
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
OrtA = Me.Ort
OrtB = Me.Ort1
OrtC = Me.Ort2
OrtD = Me.Ort3
praemieA = Me.Praemie
praemieB = Me.praemie1
Blatt3.Range("A3:W" & loLetzte).ClearContents
If .AutoFilterMode Then .AutoFilter.ShowAllData
.Range("$A$1:$W$" & loLetzte).AutoFilter
If Not OrtA = vbNullString Then
strKriterium = OrtA & "," & OrtB & "," & OrtC
.Range("$A$1:$W$" & loLetzte).AutoFilter Field:=6, Criteria1:=Split(strKriterium, ","),Operator:=xlFilterValues
boFund = True
End If
If Not praemieA = vbNullString Then
strKriterium = praemieA & "," & praemieB
.Range("$A$1:$W$" & loLetzte).AutoFilter Field:=14, Criteria1:=Split(strKriterium, ","), Operator:=xlAnd
voFund = True
End If
If Worksheets("Blatt1").AutoFilter.Range.Columns(1) _
.SpecialCells(xlCellTypeVisible).Cells.Count = 1 Then
MsgBox "Suchbegriff nicht gefunden"
If .AutoFilterMode Then .AutoFilterMode = False
Exit Sub
Else
With .AutoFilter.Range
If boFund Then
.Resize(.Rows.Count - 1).Offset(1, 0).Copy
Worksheets("Blatt3").Cells(3, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
boFund = False
End If
End With
End If
If .AutoFilterMode Then .AutoFilterMode = False
End With
Unload Me
Application.ScreenUpdating = True
End Sub
Für jede Hilfe wäre ich sehr dankbar :-)