Hallo zusammen,
ich habe folgendes Problem. Ich durchsuche mehrere Spalten eines Tabellenblattes und kopiere alle Treffer in ein weiteres Tabellenblatt. Der Bereich des zweiten Tabellenblattes ändert sich also bei jeder Abfrage. Diesen Bereich möchte ich nun über die RowSource Zuweisung in eine Listbox schreiben. Dafür nutze ich untenstehenden Code.
Dieser funktioniert auch super, nur sobald ich eine hohe Anzahl an Zeilen im zweiten Tabellenblatt stehen habe und diese in die Listbox schreiben lasse, graut sich die Listbox aus und zeigt nur noch eine graue Oberfläche.
Um eure Mithilfe wäre ich sehr dankbar.
Dim b As Integer
Dim X As Integer
Dim d As Integer
Dim c As Integer
Dim Count1 As Long
Dim i As Long
Application.ScreenUpdating = False
Sheets("source").Range("A2:W1000").Delete
Sheets("DB").Select
On Error Resume Next
Daten.StrBegriff.Text = StrConv(Daten.StrBegriff.Text, vbProperCase)
Daten.LB.RowSource = ""
Daten.LB.selected(0) = True
For i = 2 To Application.WorksheetFunction.CountA(Sheets("DB").Range("A:A"), ("B:B"), ("C:C"), ("D:D"), ("E:E"), ("F:F"), ("G:G"), ("H:H"), ("I:I"), ("J:J"), ("K:K"), _
("L:L"), ("M:M"), ("N:N"), ("O:O"), ("P:P"), ("Q:Q"), ("R:R"), ("S:S"), ("T:T"), ("U:U"), ("V:V"), ("W:W"))
For X = 1 To Sheets("DB").UsedRange.Columns.Count
If InStr(1, LCase(Cells(i, X).Value), LCase(Daten.StrBegriff.Value), 1) = 1 And Daten.StrBegriff.Value "" Then
Sheets("DB").Cells(i, X).EntireRow.Copy
Sheets("Source").Cells(1, "A").Insert
If LCase(Sheets("DB").Cells(i, 11)) = LCase("Ja") Then Daten.OB_Ja.Value = True
If LCase(Sheets("DB").Cells(i, 11)) = LCase("Nein") Then Daten.OB_Nein.Value = True
For c = 1 To 22
Daten.LB.List(LB.ListCount - 1, c) = Sheets("DB").Cells(i, c + 1).Value
Next c
End If
Next X
Next i
Sheets("Source").Select
Sheets("Source").Range("A1").Select
Count1 = 0
Do
Count1 = Count1 + 1
ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell.Offset(0, 1))
ActiveSheet.Range("A1:W" & Count1 - 1).Select
With Daten
.LB.ColumnCount = 22
.LB.ColumnWidths = "80;80;100;120;120;120;120;120;120;120;100;100;100;100;100;100;100;100;100;100;100;100;80"
.LB.RowSource = Selection.Address
End With
Call Doppelte
Application.ScreenUpdating = True