bearbeiten > suchen > option > suchen arbeitsmappe

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo
vielleicht hilft dir das was.
Das ganze in ein Modul und einer Schaltfläche zuweisen

Sub MultiSeek()
    'by Ramses
    'Sucht in der gesamten Mappe nach einem Begriff und kopiert die
    'gefundene Zeile in eine zu definfierende Ergebnistabelle
    Dim wks As Worksheet
    Dim rng As Range
    Dim sAddress As String
    'Suchbegriff
    Dim sFind As Variant
    Dim cr As Long, tarwks As String
    'Name_der_Zieltabelle
    'Bitte Anpassen !!!!
    tarwks = "Tabelle3"
    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

Gruss Rainer

Sub SuchDialog() 'Application.OnKey Dim oBtn As CommandBarControl Set oBtn = Application.CommandBars.FindControl(ID:=1849) SendKeys "%{o}", True SendKeys "%{h}", True SendKeys "%{down}", True SendKeys "%{enter}", True 'arbeitsmappe SendKeys "%{tab}", True 'suchen SendKeys "%{tab}", True 'suchen in SendKeys "%{tab}", True 'gross-/klein... SendKeys "%{tab}", True 'gesamten.. SendKeys "%{tab}", True 'option SendKeys "%{tab}", True 'alle suchen SendKeys "%{tab}", True 'weitersuchen SendKeys "%{tab}", True 'schliessen SendKeys "%{tab}", True ' SendKeys "%{tab}", True ' SendKeys "%{tab}", True 'suchen nach oBtn.Execute 'Sheets("Tabelle1").Select: Range("A1").Select End Sub

Sub MultiSuche() Dim Sh As Worksheet Dim GZelle As Range Dim FStelle$ Dim SBegriff SBegriff = InputBox("Bitte Suchbegriff eingeben:") For Each Sh In Worksheets Sh.Activate Set GZelle = Sh.Cells.Find(SBegriff) If Not GZelle Is Nothing Then FStelle = GZelle.Address Do GZelle.Activate If MsgBox("WeiterSuchen", vbYesNo + vbQuestion) = vbNo Then Exit Sub Set GZelle = Cells.FindNext(After:=ActiveCell) If GZelle.Address = FStelle Then Exit Do Loop End If Next Sh MsgBox ("Suche beendet.") End Sub

Beliebteste Forumthreads (12 Monate)

bearbeiten > suchen > option > suchen arbeitsmappe

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

bearbeiten > suchen > option > suchen arbeitsmappe

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread