Kann jemand helfen, bin am verzweifeln ....
Visual Basic:
Sub Filter()
Const Addr1 = "B2"
Const ColNo = 3
Dim Tab1 As Object, Tab2 As Object
'Dim Klasse As Range, Gruppe As Range, Name As Range
Dim sKlasse As Range, sGruppe As Range
Dim lrow As Integer
Dim wks_Liste As Worksheet
Dim wks_Resultate As Worksheet
Set wks_Liste = Worksheets(wsn_Liste)
wks_Liste.Activate
' Klasse = Worksheets(wsn_Liste).UsedRange.Find(What:=Klasse, LookIn:=xlValues, lookat:= _
' xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True).Column
'
' Gruppe = Worksheets(wsn_Liste).UsedRange.Find(What:=Gruppe, LookIn:=xlValues, lookat:= _
' xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True).Column
'
' Name = Worksheets(wsn_Liste).UsedRange.Find(What:=Name, LookIn:=xlValues, lookat:= _
' xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True).Column
Set sKlasse = Worksheets(wsn_Liste).UsedRange.Find(What:=txbKlasse.Text, LookIn:=xlValues, lookat:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
Set sGruppe = Worksheets(wsn_Liste).UsedRange.Find(What:=lboGruppe.List(i), LookIn:=xlValues, lookat:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
Application.ScreenUpdating = False
'Schleife zum durchsuchen von Tabelle1
For Each i In Range(Addr1, Range(Addr1).End(xlDown))
If Not sKlasse Is Nothing Then
ElseIf Not sGruppe Is Nothing Then
Worksheets(wsn_Liste).Row.Copy Worksheets(wsn_Resultate).Rows(lrow)
MsgBox "You have selected: " & lboGruppe.List(i)
With Worksheets(wsn_Liste)
lrow = .Cells(Rows.Count, 1).End(xlUp).Row
If lrow = 1 Then lrow = 2 Else lrow = lrow + 3
i.EntireRow.Copy Worksheets(wsn_Resultate).Rows(lrow)
End With
ElseIf sGruppe Is Nothing Then
MsgBox "Information: You have not choosen any group, so all groups will be selected."
lboGruppe.Select True
End If
Next i
Application.ScreenUpdating = True
End Sub
Zuletzt bearbeitet von einem Moderator: