Auflisten in Listbox
Gregor
Mit folgendem Makro suche ich aus einer Tabelle Projekte und gebe das Ergebnis laufend mit einer MsgBox aus. Statt der MsgBox möchte ich die gefunden Projekte in einer ListBox auflisten, das heisst alle Suchergebnisse in eine ListBox kopieren. Wie muss ich mein Makro abändern?
Sub Projekt_in_Meilensteine_suchen()
Application.ScreenUpdating = False
Dim Teilwert As Variant, Auswahl As Variant
Dim Beginn As Integer, intLastRow As Integer, Zeile As Integer, Zähler As Double
Dim Zielblatt As Variant, Quellblatt As Variant, Projekt As Variant
Dim c As Range, z As Long
Zielblatt = ActiveSheet.Name
Quellblatt = "Meilensteine"
Teilwert = InputBox(Prompt:="Bitte Projketbegriff eingeben" & vbNewLine & vbNewLine _
& " (Teil des Projektnamens)", _
Title:=" Projekt suchen", _
Default:="Wert eingeben")
If Teilwert = "" Then End
Zähler = 0
For Each c In Worksheets(Quellblatt).Columns(2).Cells
If c.Value Like "*" & Teilwert & "*" Then
Zähler = Zähler + 1
Zeile = c.Row
Auswahl = MsgBox(Worksheets(Quellblatt).Cells(Zeile, 1).Value & vbCrLf & Worksheets( _
Quellblatt).Cells(Zeile, 2).Value & vbCrLf & vbCrLf & " Weitersuchen?", vbYesNo, " Suchergebnis " & Zähler)
If Auswahl = 7 Then
Worksheets(Quellblatt).Activate
Rows(Zeile).Select
ActiveWindow.ScrollRow = Zeile
End
End If
Application.ScreenUpdating = False
End If
Next
If Zähler = 0 Then MsgBox Prompt:="Keine Übereinstimmung mit" & vbCrLf + vbCrLf _
& "'" & Teilwert & "'" _
& vbCrLf & vbCrLf & "gefunden", _
Title:=" Suchergebnis"
Application.ScreenUpdating = True
End Sub
Gregor