ich habe im Forum einen vba code gefunden der super funkioniert ich habe ihn an meine bedürfnisse angepasst. es funktioniert alles prima bis auf die inputbox die ewig weiterläuft.
das ziel diese codes ist das suchen in der userform listbox1 und das gefundene in die tabelle suchwerte zu kopieren und dann die tabelle markieren und fertig machen zum kopieren.
wenn ich in der inputbox auf abbrechen klicke dann läüft der code endlos weiter und es passiert nix .wo ist der fehler .
bitte um hilfe.
Sub MultiSelect()
On Error Resume Next
If Err.Number 0 Then
MsgBox "Kein Eintrag vorhanden!", vbCritical, "Schreiben Sie was rein"
End If
Dim wks As Worksheet
Dim rngFind As Range, rngRows As Range
Dim lngRow As Long
Dim strFind As String, strSearch As String
'TEBELLE VOR DEM EINFÜGEN LEEREN
Application.ScreenUpdating = False
Sheets("Suchwerte").Select
Columns("A:F").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Sheets("Vergleich").Select
'suchbeginn
strSearch = InputBox("Suchbegriff:", , "Turk")
Set rngFind = Cells.Find(strSearch)
If rngRows Is Nothing Then
Set rngRows = rngFind
End If
If Not rngFind Is Nothing Then 'H I E R V ER R M U T E I C H D E N F EH L ER
strFind = rngFind.Address
Do
Set rngRows = Application.Union(rngRows, rngFind.EntireRow)
Set rngFind = Cells.FindNext(After:=rngFind)
If rngFind.Address = strFind Then Exit Do
Loop
End If
rngRows.Select
Selection.Copy
Cells(1, 1).Select
'TEST BEGINN
'EINFÜGEN
Sheets("Suchwerte").Select
Range("A1").Select
ActiveSheet.Paste
'spaltenberite einstellen
Columns("A:F").Select
Columns("A:F").EntireColumn.AutoFit
Range("B1").Select
'Sheets.Add
'ActiveSheet.Name = "Suchwerte" & Sheets.Count
'ActiveSheet.Paste
Cells(1, 1).Select
Columns("D:D").Select
Selection.Delete Shift:=xlToLeft
Range("B1:D75").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub