Private Sub CommandButton1_Click()
Dim rng As Range, rngF As Range
Dim strFirst As String, lngRow() As Long, lngIndex As Long
Dim lngCalc As Long, bolAdd As Boolean
On Error GoTo ErrExit
With Application
.ScreenUpdating = False
.EnableEvents = False
lngCalc = .Calculation
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With
Redim lngRow(0)
With Worksheets("Sender")
Set rng = .Range("A:K").Find(What:=IIf(TextBox1 <> "", TextBox1, "*"), LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
If Not rng Is Nothing Then
strFirst = rng.Address
Do
If IsError(Application.Match(rng.row, lngRow, 0)) Then
bolAdd = False
Redim Preserve lngRow(lngIndex)
lngRow(lngIndex) = rng.row
lngIndex = lngIndex + 1
'Zusatzspalten-Check
bolAdd = .Cells(rng.row, 8).Text = TextBox2 Or TextBox2 = ""
If bolAdd Then bolAdd = .Cells(rng.row, 1).Text = ComboBox1.Text Or ComboBox1.Text = ""
If bolAdd Then bolAdd = .Cells(rng.row, 2).Text = ComboBox1.Text Or ComboBox1.Text = ""
If bolAdd Then bolAdd = .Cells(rng.row, 5).Text = ComboBox3.Text Or ComboBox3.Text = ""
If bolAdd Then bolAdd = .Cells(rng.row, 8).Text = ComboBox5.Text Or ComboBox5.Text = ""
If bolAdd Then bolAdd = .Cells(rng.row, 4).Text = IIf(CheckBox1, "SDTV", "HDTV") Or _
(Not CheckBox1 And Not CheckBox2)
If bolAdd Then
If rngF Is Nothing Then
Set rngF = rng.EntireRow
Else
Set rngF = Union(rngF, rng.EntireRow)
End If
End If
End If
Set rng = .Range("A:K").FindNext(rng)
Loop While Not rng Is Nothing And strFirst <> rng.Address
End If
End With
If Not rngF Is Nothing Then
rngF.Copy Worksheets("Target").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Else
MsgBox "Suchbegriff wurde nicht gefunden!"
End If
showdata.Show
Unload Me
ErrExit:
With Err
If .Number <> 0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "'CommandButton1_Click'" & vbLf & String(60, "_") & _
vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
"Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
.Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
"VBA - Fehler in Modul - Userform"
.Clear
End If
End With
On Error GoTo 0
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = lngCalc
.DisplayAlerts = True
End With
Set rng = Nothing
Set rngF = Nothing
End Sub