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