Hallo,
ich habe hier eine Suchmaske in VB erstellt und es funzt nicht ganz. Sie Suchmaske erscheint, ich kann in dem jeweiligen Feld was eingeben, drücke ich auf Start dann verschwindet die Eingabemaske und nichts passiert mehr.
Why ?
Danke im voraus.
Gruß, Pet
hier der dazugehörige Code:
Option Explicit
Sub Suchen()
'Original Unknown
'Sucht in dergesamten Mappe nach einem Begri und kopiertdie
'gefundene Zeile in eine zu definfierende Ergebnistabelle
Dim wks As Worksheet
Dim rng As Range
Dim sAddress As String, sFind As String
Dim cr As Long, tarWks As String
tarWks = „Tabelle3“ 'Name_der_Zieltabelle
cr = 65536
If Worksheets(tarWks).Cells(cr, 1) = „“ Then
cr = Worksheets(tarWks).Cells(cr, 1).End(xlUp).Row
End If
If cr = 0 Then cr = 1
'Suchbegriff definieren
sFind = InputBox(„Bitte Suchbegriff eingeben:“)
If sFind = „“ Then Exit Sub
'Suchbegriff auf Zelle definieren
'sFind = Worksheets(„Tabelle1“).Range(„A1“)
For Each wks In Worksheets
If wks.Name = tarWks Then Exit Sub
Set rng = wks.Cells.Find(What:=sFind, _
LookAt:=xlPart, LookIn:=xlFormulas)
If Not rng Is Nothing Then
sAddress = rng.Address
Do
Application.GoTo rng, True
'Für die Automation kann die „If“-Anweisung auskommentiert werden
If MsgBox("Suchbegriff: " & sFind & ",gefunden in " _
& wks.Name & ", " & rng.Address, vbYesNo + vbQuestion, „Weitersuchen ?“) = vbNo Then Exit Sub
wks.Rows(rng.Row).Copy Destination:=Worksheets(tarWks).Rows(cr)
cr = cr + 1
Set rng = wks.Cells.FindNext(after:=ActiveCell)
If rng.Address = sAddress Then Exit Do
Loop
End If
NextStart:
Next wks
MsgBox prompt:=„Keine neue Fundstelle!“
End Sub