Loop Schleife mit MSG-Abfrage
17.06.2015 14:22:53
Markus
Nach langer, langer Zeit komme ich ohne euch nicht weiter und benoetige mal wieder eure Hilfe ... Das folgende Makro soll Eintraege suchen und bei Fund den entsprechenden Wert in ein anderes Arbeitsblatt uebertragen. Solange kein Treffer gefunden wird, wird die Tabelle weiterdurchsucht - das versuche ich mit einer Do...Loop Schleife, die ich aber leider nicht richtig hinbekomme... siehe folgenden Code.
Waere toll wenn mir jemand weiterhelfen koennte.
Vielen Dank vorab schonmal, viele Gruesse
Markus
Hier der Code:
Sub Suche()
Dim rng As Range
Dim sBegriff As String, sAddress, sCode As String
Dim Mldg
sBegriff = InputBox( _
prompt:="Bitte Suchbegriff eingeben:", _
Default:="Schaumermal")
If sBegriff = "" Then Exit Sub
Set rng = Cells.Find( _
what:=sBegriff, _
lookat:=xlPart, _
LookIn:=xlValues, _
MatchCase:=False, _
after:=ActiveCell)
If rng Is Nothing Then
Beep
MsgBox "Zeichenfolge leider nicht gefunden!", , _
Application.UserName
Exit Sub
End If
sAddress = rng.Address
rng.Select
MsgBox rng.Address(False, False)
Mldg = MsgBox("Ist dies der richtige Datensatz?", _
vbYesNo + vbQuestion, "Zeichenfolge gefunden")
If Mldg = vbYes Then
sCode = Range("B" & ActiveCell.Row).Value
Sheets("Tabelle1").Range("J4") = sCode
Exit Sub
Else
Do
Cells.FindNext(after:=ActiveCell).Activate
If ActiveCell.Address = sAddress Then Exit Sub
MsgBox ActiveCell.Address(False, False)
Mldg = MsgBox("Ist dies der richtige Datensatz?", _
vbYesNo + vbQuestion, "Zeichenfolge gefunden")
If Mldg = vbYes Then
sCodiceCliente = Range("B" & ActiveCell.Row).Value
Sheets("Tabelle1").Range("J4") = sCode
Loop
End If
End Sub