Sub test()
Dim c As Range, rngBereich As Range
Dim firstAddress As String
With Sheets("Tabelle2")
Set rngBereich = .Range("C2:D" & .Cells(.Rows.Count, 4).End(xlUp).Row)
Set c = rngBereich.Find(Range("A2").Value, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
If .Cells(c.Row, 4).Value = Range("B2").Value Then
Application.ScreenUpdating = False
Range("E2:P2").Copy
.Cells(c.Row, 5).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
End If
Set c = rngBereich.FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Set rngBereich = Nothing
Set c = Nothing
End Sub