Zelleninhalt per Makro in der gesamten Mappe suchen.

[David Lange]

Hi,

ich würde gern per Makro den Inhalt der ausgewählten Zelle in der gesamten Arbeitsmappe suchen ich habe bereits per Rekorder diesen Code erstellt und etwas angepasst.
Allerdings sucht dieser nur in einem bestimmten Tabellenblatt und nicht in der gesamten Mappe.


Sub Suchen1()
'
' Suchen1 Makro
'
'
    ActiveCell.Select
    Selection.Copy
    Cells.Find(What:=ActiveCell, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    Sheets("Tabelle4").Select
    Cells.FindNext(After:=ActiveCell).Activate
End Sub

Gruß

David

[Zwergel]

Hi David,

vielleicht so:

Code:

Sub Suchen1()
'
' Suchen1 Makro
'
'
Dim wks As Worksheet
For Each wks In Worksheets
    ActiveCell.Select
    Selection.Copy
    Cells.Find(What:=ActiveCell, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    'Sheets("Tabelle4").Select
    Cells.FindNext(After:=ActiveCell).Activate
 Next wks
End Sub

[David Lange]

Danke für die schnelle Antwort bei der variante zeigt er mit an:

Fehler beim Kompilieren

For ohne Next

[Zwergel]

Bei mir läuft der Code. Wie hast du Codeergänzung bei dir eingefügt? Alles markiert und übertragen?
Die Zeile Next wks mal bündig nach links.

[David Lange]

Code:

Sub SuchenTest()
'
' Suchen1 Makro
'
'
Dim wks As Worksheet
   For Each wks In Worksheets
       ActiveCell.Select
       Selection.Copy
       Cells.Find(What:=ActiveCell, After:=ActiveCell, LookIn:=xlFormulas, _
           LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
       'Sheets("Tabelle4").Select
    Cells.FindNext(After:=ActiveCell).Activate
Next wks

End Sub

Hab den so eingetragen beim Auslösen des Makro Selektiert er nur die Aktive Zelle ich denke das Problem liegt an dem Befehl

Code:

'Sheets("Tabelle4").Select

Ich habe nur leider noch keine Möglichkeit gefunden das er alle Blätter gleichzeitig durchsucht. Das Problem hierbei ist ich könnte das Makro einfach immer neu von Tabelle 1 bis XY laufen lassen allerdings ändern sich gelegentlich die Tabellenblätter und damit würden die dann wieder nicht durchsucht werden.

Mfg

David

[Zwergel]

Hi David,

also diese Codezeile steht nur als Kommentar im Code, da Hochkomma diesen effekt bewirkt. Kannst die Zeile auch löschen.

Ich hatte gefragt, wo du den Code denn stehen hast. Er gehört in ein Modul, dann wirkt er auch für alle Tabellen und tut das, was du möchtest..

Alle Tabellen nacheinander (nicht gleichzeitig) durchsuchen. Da der Code auf alle Tabellen wirkt ist deren Anzahl und Name unerheblich.
Ich dachte, solches Grundlagenwissen wäre vorhanden.

[David Lange]

Das Makro war auch in einem Allgemeinen Modul, leider wie gesagt nicht mit dem Effekt wie gewünscht ich habe allerdings durch ein
Arbeitskollegen folgenden Code erhalten der genau das macht was ich mir vorgestellt habe. Zu dem Grundwissen muss ich leider sagen
das ich mich erst seit letzter Woche mit VBA beschäftigen muss um gewisse Listen und Tabellen zu erstellen.

Für Verbesserungsvorschläge hier das Makro von meinem Kollegen. 

Code:

Option Explicit
Global SSearch As String

Public Sub SearchAllTables()
Dim ws As Worksheet
Dim c
Dim firstAddress As String
Dim secAddress
Dim GFound As Boolean
Dim GWeiter As Boolean

GWeiter = False
GFound = False
anf:
SSearch = ActiveCell

If SSearch = "" Then
End
End If
weiter:
For Each ws In Worksheets
'ws.Select
With ws.Cells
Set c = .Find(SSearch, LookIn:=xlValues, MatchCase:=False)
If Not c Is Nothing Then
GFound = True
ws.Select
c.Select
firstAddress = c.Address
Range(ActiveCell, Cells(ActiveCell.Row, Columns.Count)).Select
If MsgBox("Weitersuchen?", vbQuestion + vbYesNo) = vbYes Then
Do
Set c = .FindNext(c)


secAddress = c.Address
If c.Address = firstAddress Then
Exit Do
End If
c.Select
If MsgBox("Weitersuchen?", vbQuestion + vbYesNo) = vbNo Then
GWeiter = True
GoTo ende
End If
Loop While Not c Is Nothing And secAddress <> firstAddress And c.Address <> firstAddress
Else
GWeiter = True
GoTo ende
End If
End If
End With
Next ws

ende:

If GFound = False Then
If MsgBox("Suchwert nicht gefunden! Neue Suche?", vbInformation + vbYesNo) = vbYes Then
GoTo anf:
End If
Else
If GWeiter = False Then
If MsgBox("Es wurden alle in Frage kommenden Suchbegriffe angezeigt! Soll die Suche neu gestartet werden?", vbInformation + vbYesNo) = vbYes Then
GoTo weiter
End If
End If
End If

End Sub

Entschuldigt meine Unwissenheit.
Gruß
David

[Zwergel]

Hi David,

ohne den neuen Code im Detail geprüft zu haben: schön wenn damit deine Vorstellungen erfüllt werden.

Da mein Code ebenfalls in allen Tabellen der Datei nach dem Suchbegriff sucht und die Fundstellen markiert, probiers mal mit meiner Datei. Einfach um zu sehen, ob die bei dir auch funktioniert.

[David Lange]

Danke für die Datei, habe diese gleich ausprobiert auch hier macht er beim aktivieren des Makros nichts weiter außer die Aktive Zelle als Kopiert zu makieren.
Was ich noch nicht erwähnt habe ich nutze Office 2010 aber ich denke das sollte hier keine rolle spielen.

Gruß David

[Zwergel]

Hi,

nee, dann schau dir mal die anderen Tabellen an, der Suchbegriff ist in allen Tabellen markiert.

Falls du etwas anderes erwartet hast, dann habe ich deine Fragestellung falsch verstanden.