Option Explicit
Sub Test()
Dim myWs As Worksheet
Dim Z As Double
Dim J As Long
Dim i As Long
Rem - erscheint das variable Kriterium für die AND (aber ohne Leerräume) als
Dim R As Long
Dim Zeile() As Long
Dim stp() As Integer
Dim aZ As Long
Dim IsIt As Boolean
For Each myWs In ActiveWorkbook.Sheets
If InStr(myWs.Name, "Cluster") Then
Z = myWs.Cells(1, 4).Interior.Color
R = myWs.Cells(Rows.Count, 2).End(xlUp).Row
ReDim Zeile(1 To R)
ReDim stp(1 To R)
For J = 1 To R
If myWs.Cells(J, 2) <> 0 Then
stp(J) = myWs.Cells(J, 2).Value
Zeile(J) = Sheets("Tabelle1").Columns("A:A").Find(What:=stp(J), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Row
End If
Next J
For i = 2 To 10
For aZ = 3 To UBound(Zeile)
IsIt = True
If Sheets("Tabelle1").Cells(Zeile(aZ), i).Value = "x" Then
IsIt = IsIt And True
Else
IsIt = IsIt And False
End If
Next aZ
If IsIt Then
Range(Sheets("Tabelle1").Cells(Zeile(1), i), _
Sheets("Tabelle1").Cells(Zeile(2) - 1, i)).Select
Sheets("Tabelle1").Cells(Zeile(2) - 1, i).Activate
With Selection.Interior
.Color = Z
End With
End If
Next i
End If
Next myWs
End Sub