ich würde gerne erreichen, dass der in einer Suchmaske genannte Begriff in Spalte H des Tabellenblattes "Maßnahmen" gesucht wird und die jeweilige Zeile in der sich der Begriff befindet von A:H in das Tabellenblatt "Einstellungen" ab A15 hineinkopiert wird. In A14:H14 sollte immer jeweils die Überschrift aus "Maßnahmen" A1:H1 hineinkopiert wird. Der gesuchte Begriff kann häufiger vorkommen, so dass alle betroffenen Zeilen sich zum Schluß der Suche in Tabelle Einstellungen befinden sollten. Wäre das realisierbar bzw. wie müßte ich den folgenden Code anpassen? Danke schon jetzt für die Rückmeldungen.
Herzliche Grüße
Wolfgang
Sub SuchenKopieren()
Static Suchbegriff As String
Dim Zelle As Variant, ErsteAdresse As String
Dim LetzteZelle As Integer, intCount As Integer
Application.ScreenUpdating = False
Worksheets("Einstellungen").Range("A14:H1000").Cells.Clear 'Alte Tabelleninhalte lö _
schen
Suchbegriff = InputBox(Prompt:="Bitte Suchbegriff eingeben:", _
Default:=Suchbegriff)
If Suchbegriff = "" Then MsgBox "Bitte Suchbegriff eingeben", vbCritical
Exit Sub
With Worksheets("Maßnahmen")
'Überschriftenzeile kopieren ...
.Rows(1).Copy Destination:=Worksheets("Maßnahmen").Range("a1")
With .UsedRange
Set Zelle = .Find(What:=Suchbegriff, After:=Range("A1"), _
LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlNext, MatchCase:=True)
If Not Zelle Is Nothing Then
ErsteAdresse = Zelle.Address
LetzteZelle = 2
Do
.Rows(Zelle.Row).Copy _
Destination:=Worksheets("Einstellungen").Range("a14:H") _
.Cells(LetzteZelle, 1)
Set Zelle = .FindNext(Zelle)
LetzteZelle = LetzteZelle + 1
Loop While Not Zelle Is Nothing And _
Zelle.Address ErsteAdresse
End If
Worksheets("Maßnahmen").Select
Range("a1").Select
End With
End With
Application.ScreenUpdating = True
End Sub