Sub
AktuelleEintr()
Dim
z
As
Long
, lZ
As
Long
Dim
Contract
As
String
Dim
Eintrag
As
range
Dim
Startw
As
String
Worksheets(
"Gesamt DB"
).
Select
lZ = Worksheets(
"Gesamt DB"
).Cells(Rows.Count, 1).
End
(xlUp).Offset(-1, 0).Row
For
z = lZ
To
8
Step
-1
Contract = Worksheets(
"Gesamt DB"
).Cells(z, 3).Value
If
Worksheets(
"Gesamt DB"
).Cells(z, 2).Value =
"Fertig"
Then
Set
Eintrag = Worksheets(
"Gesamt DB"
).range(
"C8"
, Cells(Rows.Count, 3).
End
(xlUp)).Find(Contract)
Startw = Eintrag.Address
Do
If
Eintrag.Offset(0, -1).Value =
"In Arbeit"
Then
Rows(Eintrag.Row).Value =
""
End
If
Set
Eintrag = Worksheets(
"Gesamt DB"
).range(
"C8"
, Cells(Rows.Count, 3).
End
(xlUp)).FindNext(Eintrag)
Loop
While
Not
Eintrag
Is
Nothing
And
Eintrag.Address <> Startw
End
If
If
Worksheets(
"Gesamt DB"
).Cells(z, 1).Value =
""
Then
Rows(z).Delete
End
If
Next
End
Sub