Sub Suchen_alle_Tabellen()
Dim wks As Worksheet
Dim rng As Range
Dim sAddress As String, sFind As String
sFind = InputBox("Bitte Suchbegriff eingeben:")
For Each wks In Worksheets
Set rng = wks.Cells.Find( _
what:=sFind, _
lookat:=xlWhole, _
LookIn:=xlFormulas)
If Not rng Is Nothing Then
sAddress = rng.Address
Do
Application.Goto rng, True
If MsgBox( _
prompt:="Weiter", _
Buttons:=vbYesNo + vbQuestion _
) = vbNo Then Exit Sub
Set rng = Cells.FindNext(after:=ActiveCell)
If rng.Address = sAddress Then Exit Do
Loop
End If
Next wks
MsgBox prompt:="Keine neue Fundstelle!"
End Sub
gruß
ae
'Ok anbei der kompl. Code mit kleinen Erläuterungen
'Aufbau: (UserForm)
'- 2 CommandButton (ComandButton1/CmdAbbruch)
'- 6 TextBoxen (txtAngebotNr/txtDatum/txtKunde/ect..)
'- 2 Listboxen (ListBox1/ListBox2)
'-die text boxen kanst du natürlich anpassenPrivate Sub CmdAbbruch_Click()
Unload Me
End Sub
Private Sub CommandButton1_Click()
Dim s As String
Dim Found As Range
Dim FirstAddress As String
Dim i As Integer ' Zeile
i = 0
If txtSuche.Text = "" Then
MsgBox "Kein Eintrag vorhanden!", vbCritical, "Was soll ich den suchen?"
txtSuche.SetFocus
Else
End If
Eingabe = txtSuche.Text
If Eingabe = "" Then Exit Sub
ListBox1.Clear
ListBox2.Clear
With ActiveSheet
Set Found = .Cells.Find(Eingabe, LookAt:=xlPart)
If Not Found Is Nothing Then
FirstAddress = Found.Address
ListBox1.ColumnCount = 2
ListBox1.AddItem Found
ListBox1.List(i, 1) = Cells(Found.Row, 13)
ListBox2.AddItem Found.Row
i = i + 1
Do
Found.Activate
Set Found = Cells.FindNext(After:=ActiveCell)
On Error Resume Next
If Found.Address = FirstAddress Then Exit Do
ListBox1.AddItem Found
ListBox1.List(i, 1) = Cells(Found.Row, 13)
ListBox2.AddItem Found.Row
i = i + 1
Loop
End If
End With
CommandButton1.Caption = "Neue Suche"
End Sub'##############################
'Hier erfolgt die Ausgabe des gesuchten
'in einer TextBox per Auswahl in der ListBoxPrivate Sub ListBox1_Click()
If ListBox1.Value <> "" Then
On Error Resume Next
ListBox2.ListIndex = ListBox1.ListIndex
txtAngebotNr = Cells(ListBox2.Value, 2)
txtDatum = Cells(ListBox2.Value, 3)
txtKunde = Cells(ListBox2.Value, 5)
txtOrt = Cells(ListBox2.Value, 10) & " " & Cells(ListBox2.Value, 11)
txtGesamtPreis = Cells(ListBox2.Value, 20) & " "
txtAuftragswert = Cells(ListBox2.Value, 21) & " "
End If
End Sub'#################################
'Hier wird die betreffende Zeile markiert bei
'einem DoppelklickPrivate Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If ListBox1.Value <> "" Then
On Error Resume Next
ListBox2.ListIndex = ListBox1.ListIndex
Rows(ListBox2.Value).Select
End If
End SubPrivate Sub Userform_Activate()
CommandButton1.Caption = "Suche"
End SubIVAN