Gruppe
Allgemein
Problem
Die Zeile mit der letzten Fundstelle eines Suchbegriffs soll an letzte Position der Tabelle kopiert werden.
StandardModule: Modul1
Sub Auswahl()
Dim rng As Range, rngLast As Range
Dim lRow As Long
Dim sBegriff As String, sAddress As String
sBegriff = InputBox( _
prompt:="Bitte Suchbegriff eingeben:", _
Default:="Hallo")
If sBegriff = "" Then Exit Sub
Set rng = Cells.Find( _
what:=sBegriff, _
lookat:=xlWhole, _
LookIn:=xlValues, _
MatchCase:=False, _
after:=ActiveCell)
If rng Is Nothing Then
Beep
MsgBox "Suchbegriff nicht gefunden!", , _
Application.UserName
Exit Sub
End If
sAddress = rng.Address
rng.Select
rng.Offset(1).Select
Do
Set rngLast = ActiveCell
Cells.FindNext(after:=ActiveCell).Activate
If ActiveCell.Address = sAddress Then Exit Do
Loop
lRow = Range("A1").CurrentRegion.Rows.Count + 1
Rows(lRow).Value = rngLast.EntireRow.Value
End Sub