Schöne Grüße
Sub kopieren()
Dim wksQ As Worksheet, wksZ As Worksheet
Dim suche, letzte As Long, zelle As Range
Set wksQ = Worksheets(2) '--Quellblatt gemaess Index
Set wksZ = Worksheets(3) '--Ziellblatt gemaess Index
suche = Application.InputBox("was suchen", "Suche")
Set zelle = wksQ.Cells.Find(What:=suche, LookIn:=xlValues, lookat:=xlWhole)
If Not zelle Is Nothing Then
letzte = wksZ.UsedRange.SpecialCells(xlCellTypeLastCell).Row
wksQ.Rows(zelle.Row).Copy wksZ.Cells(letzte + 1, 1)
zelle.EntireRow.Delete
End If
Set wksQ = Nothing
Set wksZ = Nothing
Set zelle = Nothing
End Sub
gruss hary