Sub
umordnen()
Dim
werte()
Dim
i
As
Integer
Dim
a
As
Integer
Dim
ende
As
Long
ReDim
werte(0)
werte(0) = 0
ende = ActiveSheet.Cells(Rows.Count, 1).
End
(xlUp).Row
If
ende > 1
Then
For
i = 2
To
ende
werte(0) = werte(0) + 1
ReDim
Preserve
werte(werte(0))
werte(werte(0)) = Cells(i, 1)
Next
i
End
If
If
werte(0) > 0
Then
For
i = 1
To
Int(werte(0) / 4)
Cells(i + 1, 5) = werte(4 * (i - 1) + 1)
Cells(i + 1, 6) = werte(4 * (i - 1) + 2)
Cells(i + 1, 7) = werte(4 * (i - 1) + 3)
Cells(i + 1, 8) = werte(4 * (i - 1) + 4)
Next
i
End
If
If
werte(0) - Int(werte(0) / 4) > 0
Then
For
a = 1
To
werte(0) - Int(werte(0) / 4) * 4
Cells(i + 1, 4 + a) = werte(4 * (i - 1) + a)
Next
a
End
If
End
Sub