Sub
frist_kopieren()
Dim
ende
As
Integer
Dim
ende2
As
Integer
Dim
i
As
Long
Dim
b
As
Long
Dim
anzahl
As
Variant
Dim
ergebnis
As
Object
Dim
suche
As
String
ende = Worksheets(1).Cells(Rows.Count, 1).
End
(xlUp).Row
For
i = 3
To
ende
anzahl = Application.WorksheetFunction.CountIf(Worksheets(1).Rows(i),
"<"
&
CDbl
(
Date
))
If
anzahl > 0
Then
suche = Worksheets(1).Cells(i, 1).Value
Set
ergebnis = Worksheets(2).Columns(1).Find(suche, LookIn:=xlValues)
If
ergebnis
Is
Nothing
Then
ende2 = Worksheets(2).Cells(Rows.Count, 1).
End
(xlUp).Row
Worksheets(1).Rows(i).Copy Destination:=Worksheets(2).Rows(ende2 + 1)
Else
If
Worksheets(1).Cells(i, 1) & Worksheets(1).Cells(i, 2) & Worksheets(1).Cells(i, 3) & Worksheets(1).Cells(i, 4) & Worksheets(1).Cells(i, 5) = Worksheets(2).Cells(ergebnis.Row, 1) & Worksheets(2).Cells(ergebnis.Row, 2) & Worksheets(2).Cells(ergebnis.Row, 3) & Worksheets(2).Cells(ergebnis.Row, 4) & Worksheets(2).Cells(ergebnis.Row, 5)
Then
Worksheets(1).Rows(i).Copy Destination:=Worksheets(2).Rows(ergebnis.Row)
Else
Worksheets(1).Rows(i).Copy Destination:=Worksheets(2).Rows(ende2 + 1)
End
If
End
If
End
If
Next
i
End
Sub