Suche über mehrere Tabellenblätter
Katy
ich habe folgendes Problem und hoffe Ihr könnt mir da vielleicht helfen:
Gegeben ist eine Excel Datei mit mehreren Tabellenblättern, die als Datenbank fungiert.
Die Tabellenblätter haben jeweils einen Kopf von mehreren Zeilen, darunter (beginnt in jedem Blatt ab der gleichen Zeile) stehen Texte.
Spalten C und D, und Spalte E und F sind zusammengefasst und in Ihnen steht fortlaufender Text.
Ziel ist nun ein Wort über alle Tabellenblätter hinweg zu suchen und die betroffenen Zeilen in ein neues Tabellenblatt zu kopieren.
Ich habe mit Hilfe eines anderen Foreneintrags schon folgendes, dass soweit funktioniert:
Sub suche()
Dim c As Range
Dim Suchwert As Variant
Dim ws As Worksheet
Dim ersterFundort As String
Dim i As Integer, z As Long
z = 1
Do
Suchwert = InputBox("Suchbegriff", "Suchbegriff")
Loop While Suchwert = ""
For Each ws In Sheets
If ws.Name = "Suchergebnis" Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
Next
Sheets.Add After:=Sheets(Sheets.Count)
Set ws = ActiveSheet
ws.Name = "Suchergebnis"
ws.Cells(1, 1).Value = "Suchergebnis"
ws.Cells(1, 2).Value = "im Tab.blatt"
ws.Cells(1, 3).Value = "Zelladresse"
For i = 1 To Sheets.Count - 1
Set c = Sheets(i).Cells.Find(what:=Suchwert, lookat:=xlValue)
If Not c Is Nothing Then
Do Until c Is Nothing Or c.Address = ersterFundort
If ersterFundort = "" Then ersterFundort = c.Address
z = z + 1
With ws
.Cells(z, 3).Value = c.Address(False, False)
.Cells(z, 2).Value = Sheets(i).Name
.Hyperlinks.Add Anchor:=.Cells(z, 1), Address:="", _
SubAddress:=Sheets(i).Name & "!" & c.Address(False, False), _
TextToDisplay:=CStr(c)
End With
Set c = Sheets(i).Cells.FindNext(c)
Loop
End If
Set c = Nothing
ersterFundort = ""
Next
End Sub
Problem ist jetz das Format des Suchergebnisses. Es soll ja die gesamte betroffene Zeile von C bis F herauskopiert werden soll. Wünschenswert wäre die Quellenangabe die dieser VBA Text jetzt macht (Tabellenblatt und Zelladresse) beizubehalten.
Ich hoffe sehr, dass mir hier jemand helfen kann, da ich mich leider überhaupt nicht mit VBA auskenne.
Dankeschön schon mal!
Anzeige