ohne weitere Informationen würde ich das so lösen. Es darf aber keine Zusage im Quellbereich mittendrin hinzukommen.
Sub
BedingteKopieZeilen()
Dim
Zeile
As
Long
Dim
n
As
Long
Application.screeenupdating =
False
With
Tabelle1
n = 4
For
Zeile = .UsedRange.Row
To
.UsedRange.SpecialCells(xlCellTypeLastCell).Row
If
.Cells(Zeile, 3).Value =
"Zusage"
Then
If
Tabelle4.Cells(n, 3) =
""
Then
Tabelle4.Cells(n, 1).Resize(.UsedRange.Columns.Count).Value = Intersect(.UsedRange, .Rows(Zeile)).Value
End
If
n = n + 1
End
If
Next
Zeile
End
With
Application.screeenupdating =
True
End
Sub