Ich geb jetzt einfach mal den Code rein - vieleicht findet sich ja doch einer >_>

Es wäre nur das Problem, das er momentan in den Listboxen die Auswahlkriterien zweifach wählt, also das UND das - er soll aber eigentlich das ODER das nehmen?!

Option Explicit

Private Sub CommandButton2_Click()
Dim i, Listenlänge As Long
Dim Erstezeile As String
Dim Fundort As Range
Dim Quelltabelle, Zieltabelle As Worksheet
Application.ScreenUpdating = False
Set Quelltabelle = Workbooks("Wasserfall-Modell.xls").Worksheets("Gefiltert")
Set Zieltabelle = Workbooks("Wasserfall-Modell.xls").Worksheets("Fertig")

'Filter (OWNER) waehlen und in Zeile kopieren
For i = 1 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
With Quelltabelle.Range("C")
Set Fundort = .Find(ListBox1.List(i), , , xlWhole)
If Not Fundort Is Nothing Then
Erstezeile = Fundort.Address
Do
Listenlänge = 1 + Zieltabelle.Cells(Rows.Count, 1).End(xlUp).Row
Quelltabelle.Range(Fundort.Row & ":" & Fundort.Row).Copy Destination:= _
Zieltabelle.Range(Listenlänge & ":" & Listenlänge)
Set Fundort = .FindNext(Fundort)
Loop While Not Fundort Is Nothing And Fundort.Address <> Erstezeile
End If
End With
End If
Next
'Filter (PROCESS_GROUP) waehlen und in Zeile kopieren
For i = 1 To ListBox2.ListCount - 1
If ListBox2.Selected(i) = True Then
With Quelltabelle.Range("D")
Set Fundort = .Find(ListBox2.List(i), , , xlWhole)
If Not Fundort Is Nothing Then
Erstezeile = Fundort.Address
Do
Listenlänge = 1 + Zieltabelle.Cells(Rows.Count, 1).End(xlUp).Row
Quelltabelle.Range(Fundort.Row & ":" & Fundort.Row).Copy Destination:=Zieltabelle.Range(Listenlänge & ":" & Listenlänge)
Set Fundort = .FindNext(Fundort)
Loop While Not Fundort Is Nothing And Fundort.Address <> Erstezeile
End If
End With
End If
Next
Listenlänge = Zieltabelle.Cells(Rows.Count, 1).End(xlUp).Row
For Listenlänge = Listenlänge To 1 Step -1
If Application.WorksheetFunction.CountIf(Zieltabelle.Columns(1), Zieltabelle.Cells(Listenlänge, 1).Value) > 1 Then
Zieltabelle.Rows(Listenlänge).Delete
End If
Next
Application.ScreenUpdating = True
End Sub

Private Sub UserForm_Initialize()
Dim ws As Worksheet
Dim xErsteZeile As Long
Dim xZeile As Long

'PROZESSGRUPPEN Spalte D
ThisWorkbook.Worksheets("Gefiltert").Range("C").Copy Destination:=Filter_setzen.Range("A")
Set ws = ThisWorkbook.Worksheets("Filter_setzen")
xErsteZeile = ws.Cells(Rows.Count, 1).End(xlUp).Row
For xZeile = xErsteZeile To 1 Step -1
If Application.WorksheetFunction.CountIf(ws.Columns(1), ws.Cells(xZeile, 1).Value) > 1 Then
ws.Cells(xZeile, 1).Delete
'ws.Rows(xZeile).Delete
End If
Next
For xZeile = xErsteZeile To 1 Step -1
If Application.WorksheetFunction.CountIf(ws.Columns(2), ws.Cells(xZeile, 2).Value) > 1 Then
ws.Cells(xZeile, 2).Delete
'ws.Rows(xZeile).Delete
End If
Next

'Schnelles Loeschen der A8-Zelle, wegen Verschiebung durch Loeschen und dem C11N0
Sheets("Filter_setzen").Select
Range("A8").Select
Selection.ClearContents

'In Listbox übergeben
ListBox1.MultiSelect = fmMultiSelectExtended
ListBox2.MultiSelect = fmMultiSelectExtended
ListBox1.RowSource = "Filter_setzen!A18"
ListBox2.RowSource = "Filter_setzen!B18"
'UserForm1.Show

End Sub