Option Explicit
Sub Test()
Dim wksA As Excel.Worksheet
Dim wksB As Excel.Worksheet
Dim rngKeyword As Excel.Range
Dim rngItemColumn As Excel.Range
Dim rngMatch As Excel.Range
Set wksA = Worksheets("Tabelle1")
Set wksB = Worksheets("Tabelle2")
With wksA.Rows(1)
Set rngMatch = .Find("Schluesselwort", , xlValues, xlWhole, xlByRows, , False)
If rngMatch Is Nothing Then
Call MsgBox("Schluesselwort nicht gefunden.", vbExclamation)
Exit Sub
End If
End With
Set rngKeyword = rngMatch.Offset(1)
With wksB.Rows(1)
Set rngItemColumn = .Find("ITEM", , xlValues, xlPart, xlByRows, , False)
If rngItemColumn Is Nothing Then
Call MsgBox("Spalte 'ITEM' nicht gefunden.", vbExclamation)
Exit Sub
End If
End With
Dim rngCell As Excel.Range
Do While rngKeyword.Value <> ""
With wksB.Rows(1)
Set rngMatch = .Find(rngKeyword.Value, , xlValues, xlWhole, xlByRows, , False)
End With
If Not rngMatch Is Nothing Then
Set rngMatch = rngMatch.Offset(1)
Do While rngMatch.Value <> ""
If rngMatch.Value = "HIDE" Then
Set rngCell = rngMatch.Worksheet.Cells(rngMatch.Row, rngItemColumn.Column)
Call MsgBox(rngCell.Address & " = '" & rngCell.Value & "'", vbInformation)
End If
Set rngMatch = rngMatch.Offset(1)
Loop
End If
Set rngKeyword = rngKeyword.Offset(1)
Loop
End Sub