VBA - Find Funktion loopen
15.06.2020 22:11:29
Dominic
ich bin ratlos und habe alles probiert, habe gesucht, geforscht aber komme nicht so ganz weiter. Ich hoffe ihr könnt mir helfen. Es kann bestimmt sein, dass es die Lösung im Forum in irgendeiner Form schon gibt, aber seht mir es bitte nach, ich blicke auch bei den Lösungen nicht komplett durch.
Ich habe folgende Tabelle:
Spalte A: Namen von Personen
Zeile 1: Jahreszahlen
Die Tabelle gibt an welche Person sich in welchem Jahr auf welche Stelle beworben hat.
Jetzt möchte ich eine Schaltfläche einfügen, die beim Drücken:
- eine Sucheingabemaske beinhaltet und nach der jeweiligen Stelle fragt
- die eingegebene Stelle in der Tabelle sucht
- ein neues Arbeitsblatt mit dem Suchbegriff als Namen erzeugt
- in diesem Arbeitsblatt die Suchbegriffe wie folgt auflistet:
A1: Name1; B1: Jahreszahl der Bewerbung
A2: Name 2; B2: Jahreszahl der Bewerbung
etc.
Ich habe die Suche mit der Find-Funktion schon so hinbekommen, dass es funktioniert. Allerdings schaffe ich es nicht, eine Loop einzubauen, sodass die Suche nicht bei dem ersten Ergebnis abbricht.
Mein Code sieht wie folgt aus:
Public Sub suchen()
Dim finden As Range
Dim suchbegriff As String
Dim cell As Range
suchbegriff = InputBox( _
prompt:="Stelle eingeben:", _
Default:="Stelle")
ActiveWorkbook.Sheets.Add After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)
ActiveSheet.name = suchbegriff
Worksheets("Tabelle 1").Activate
Set finden = Range("A2:D4").Find(what:=suchbegriff, MatchCase:=False, lookat:=xlPart)
Cells(finden.Row, 1).Select
With Worksheets(suchbegriff)
ActiveCell.Copy Destination:=.Range("A1").End(xlUp).Offset(0)
End With
Worksheets("Tabelle 1").Activate
Cells(1, finden.Column).Select
With Worksheets(suchbegriff)
ActiveCell.Copy Destination:=.Range("A1").End(xlUp).Offset(0, 1)
End With
End Sub
Vorab vielen Dank für eure Mühen!
Viele Grüße
Dominic