msgbox

Sub ladeliste()
Dim SuBe As Range
Dim s As String, za1 As String, za2 As String, za3 As String, za4 As String
Dim I As Long, fiR As Long, laRq As Long, laRz As Long
Dim laC As Integer
Dim gef As Boolean
Const bartikel As String = "artikel"
Const barchiv As String = "archiv"
s = InputBox("bitte das gesuchte Kennzeichen eingeben:", "Fahrzeug suchen und kopieren")
If s = "" Then
MsgBox "Es wurde kein Suchbegriff eingegeben !", vbExclamation, _
"Hinweis für " & Application.UserName & ":"
Exit Sub
End If
fiR = 1
laRq = Sheets(bartikel).Cells(Rows.Count, 1).End(xlUp).Row
For I = 1 To laRq
gef = False
Set SuBe = Sheets(bartikel).Range("A" & fiR).Find(s, lookat:=xlWhole)
If SuBe Is Nothing Then _
Set SuBe = Sheets(bartikel).Range("A" & fiR & ":A" & laRq + 1). _
Find(s, lookat:=xlWhole)
If Not SuBe Is Nothing Then
gef = True
fiR = SuBe.Row + 1
laC = Sheets(bartikel).Cells(SuBe.Row, Columns.Count).End(xlToLeft).Column
za1 = Cells(SuBe.Row, 1).Address(False, False)
za2 = Cells(SuBe.Row, laC).Address(False, False)
Sheets(bartikel).Range(za1 & ":" & za2).copy
'*löscht den gefundenen eintrag
'Sheets(bartikel).Range(za1 & ":" & za2).Delete
laRz = Sheets(barchiv).Cells(Rows.Count, 1).End(xlUp).Row
If laRz = 1 And IsEmpty(Sheets(barchiv).Cells(1, 1)) Then laRz = 0
laRz = laRz + 1
za3 = Cells(laRz, 1).Address(False, False)
za4 = Cells(laRz, laC).Address(False, False)
Sheets(barchiv).Range(za3 & ":" & za4).PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets(bartikel).Range(za1 & ":" & za2).Delete
Else
If gef = False And MsgBox("Das Fahrzeug '" & s & "' wurde nicht gefunden !", _
vbExclamation, "das Fahrezug ist nicht in der Liste") Then
'hier soll sie abfrage rein ob ich weiter suchen möchte oder nicht wenn ja dann suchen
' wenn nein beenden
Exit For
Exit Sub
End If
End If
Exit For
Next I
End Sub