VBA/Excel - sicher einfacher, als es klingt... Könnt Hilfe gebrauchen!

[Gary]

Hallo, habe wirklich die "xlRecherche" ausgiebig durchsucht, aber nicht wirklich das gefunden was ich möchte :-)

...also hier nun meine kleine Aufgabe und somit Frage an Kenner:

Ich habe mit Excel zwei LISTBOXEN erstellt - diese enthaltenen Werte sollen mehrfach auswählbar sein, und sollten diese Auswahl dann getroffen sein - soll per Startknopf diese Auswahl in ein neues Tabellenblatt entstehen.
Grundlage ist einfach eine Tabelle (mit insg. 26 Spalten), und diese LISTBOX soll die (man sieht es im Autofiltermodus) Werte enthalten die da enthalten sind (keine Duplikate) - handelt sich um Spalte C und Spalte D.
Sollte dann die Auswahl getroffen sein, startet man die "Automatisierung" (Startknopf) und es nimmt diese Filter und erstellt eine neue Tabelle mit allen dazugehörigen anderen Spalten und Zeilen.

Einfach zu erklären wäre es vieleicht - es soll quasi so funktionieren, als setze ich meine ganzen "Autofilter" (allerdings sollten es mehr als 2 auswählbar sein, Excel gehen ja nur 2 Bedingungen) und kopiere diese gefilterte Tabelle neu in ein Arbeitsblatt. Mit Aufzeichnen komm ich da sicher nicht weiter, weil ich dann alle möglichen Kombinationen aufzeichen müsste, die der jenige dann auswählen kann/möchte...

Für Hilfe wär ich sehr dankbar, das ist bestimmt wieder schwerer von mir erklärt als es ist.
*Bitte-um-Hilfe*

Grüße


P.S.: Hatt sich erledigt... hab mich nun lange selbst durchgewurschtelt...

[Gary]

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