Public
Sub
Auffüllen()
Dim
loLetzte
As
Long
, i
As
Long
Application.ScreenUpdating =
False
Application.Calculation = xlCalculationManual
With
Worksheets(
"Tabelle1"
)
loLetzte = .Cells(.Rows.Count, 1).
End
(xlUp).Row + 1
For
i = 1
To
loLetzte
If
.Cells(i, 1) =
""
Then
If
.Cells(i, 1).Interior.ColorIndex = 44
Then
.Range(.Cells(i - 1, 1), .Cells(i, 3)).Copy
.Cells(i, 1).PasteSpecial Paste:=xlValues
.Cells(i - 1, 5).Copy
.Cells(i, 5).PasteSpecial Paste:=(xlValues)
End
If
End
If
Next
i
End
With
Application.Calculation = xlCalculationAutomatic
Application.CutCopyMode =
False
End
Sub