This will do:
Sub M_snb()
sn = Cells(1).CurrentRegion
ReDim sp(UBound(sn), 3 * UBound(sn))
y = sn(1, 2)
y1 = sn(1, 4)
y2 = sn(1, 6)
n = -1
n1 = -1
n2 = -1
For j = 1 To UBound(sn)
If sn(j, 2) <> y Then
y = sn(j, 2)
n = 0
q = q + 1
Else
n = n + 1
End If
If sn(j, 4) <> y1 Then
y1 = sn(j, 4)
n1 = 0
q1 = q1 + 1
Else
n1 = n1 + 1
End If
If sn(j, 6) <> y2 Then
y2 = sn(j, 6)
n2 = 0
q2 = q2 + 1
Else
n2 = n2 + 1
End If
sp(n, 3 * q) = sn(j, 1)
sp(n1, 3 * q1 + 1) = sn(j, 3)
sp(n2, 3 * q2 + 2) = sn(j, 5)
Next
Cells(10, 9).Resize(UBound(sp), UBound(sp, 2)) = sp
End Sub