Private Sub CommandButton1_Click()
Dim a(1000)
i = 1
Do While Cells(i, 1) <> ""
a(i) = Cells(i, 1)
i = i + 1
Loop
p = Int((i - 1) / 8 + 0.9)
n = 0: m = 0
For i = 1 To p Step 2
For j = 1 To 8
Cells(i, j + 1) = a(j + i - 1 + n)
Next
For j = 1 To 8
Cells(i + 1, j + 1) = a(17 - j + m)
Next
n = n + 14
m = m + 16
Next
End Sub