Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
420to424
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
420to424
420to424
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
In mehren Tabellenblätter suchen und ausgeben
Silke
Hallo Excelaner,
ich habe ein kleines Problem
ich möchte auf einem Tabellenblatt ('Tabelle1') ein Stichwort eingeben in Zelle A4, nun möchte ich das er in den anderen 10 TAbellenblätter (TAbelle2-11) die noch vorhanden sind nach diesem Stichwort sucht (insgesamt 10 Spalten pro Tabellenblatt) und mir wenn was gefunden die kompletten Datenzeilen der gefundenen Stichwortes in Tabelle1 angefangen bei A6 ausgibt.
ist dieses möglich?
Gruß Silke

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: In mehren Tabellenblätter suchen und ausgeben
Ramses
Hallo
das sollte funktionieren.
Es ist relativ einfach anzupassen.

Sub MultiSeek()
'Original Unknown
'Modified 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
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

Gruss Rainer
Anzeige
AW: In mehren Tabellenblätter suchen und ausgeben
Uwe
Hallo Silke,
probiere es mal damit:
Option Explicit

Sub ListeGefundenerZellen()
Dim A As Long
Dim R As Long
Dim S As String
Dim Z As Range
Dim WS As Worksheet
Dim Liste As Worksheet
Set Liste = ActiveSheet
S = Liste.Range("A4")
If S = "" Then Exit Sub
'S = "*" & S & "*"  'es werden auch Zellen angezeigt, die noch mehr als den Suchstring enthalten
With Liste
.Rows("6:" & .Cells.SpecialCells(xlCellTypeLastCell).Row).Clear
.Cells(6, 1) = "Suchbegriff: """ & S & """"
.Cells(7, 1) = "Tabelle, Zeile"
.Cells(8, 1) = "komplette Zeile"
.Cells(7, 1).Interior.ColorIndex = 15
End With
A = 9
For Each WS In ThisWorkbook.Worksheets
R = 0
For Each Z In WS.UsedRange.Cells
If Z.Text Like S And WS.Name <> Liste.Name Then
If R < Z.Row Then
A = A + 1
Liste.Cells(A, 1) = WS.Name & ", Zeile " & Z.Row
Liste.Cells(A, 1).Interior.ColorIndex = 15
A = A + 1
Z.EntireRow.Copy
Liste.Rows(A).PasteSpecial Paste:=xlValues
End If
Liste.Rows(A).Borders(xlEdgeBottom).Weight = xlThin
Liste.Cells(A, Z.Column).Interior.ColorIndex = 6
If R < Z.Row Then R = Z.Row
End If
Next Z
Next WS
Liste.Columns.AutoFit
Liste.Cells(A + 1, 1).Select
End Sub

Gruß Uwe
Anzeige
AW: In mehren Tabellenblätter suchen und ausgeben
27.04.2004 14:00:38
Silke
Hallo Ramses, Hallo Uwe Küstner
ich werde die Programme gleich mal ausprobieren
erts mal Vielen DAnk, sollte ich noch fragen haben, melde ich mich nochmal
Gruss Silke

302 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige