Option
Explicit
Sub
Auto_open()
Application.ThisWorkbook.RefreshAll
Dim
Blatt
As
Object
Dim
Arr()
Dim
lz
As
Long
Dim
t
As
Long
On
Error
Resume
Next
For
Each
Blatt
In
Worksheets
Blatt.Activate
lz = Blatt.Cells(Rows.Count, 3).
End
(xlUp).Rows.Row
For
t = lz
To
3
Step
-1
If
Blatt.Cells(t, 2).Value =
"So"
Then
Arr = Blatt.Cells(lz, 1).EntireRow.FormulaR1C1
Blatt.Cells(lz, 1).EntireRow.ClearContents
Blatt.Rows(t).Delete Shift:=xlUp
Blatt.Cells(lz, 1).EntireRow.FormulaR1C1 = Arr
End
If
If
Blatt.Cells(t, 13).Value <= 0.93
Then
Blatt.Cells(t, 13).Font.ColorIndex = 3
End
If
Next
t
Next
Blatt
End
Sub