Sub Toto()
Dim i As Integer, j As Integer
Dim tbl() As Variant
tbl = Sheets(1).Range("B7:W14").Value
For i = 1 To UBound(tbl, 2) Step 2
For j = LBound(tbl, 1) To UBound(tbl, 1)
If Sheets(2).Range("B1") = "" Then
Sheets(2).Range("B1") = tbl(j, 1)
Else
Sheets(2).Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = tbl(j, i)
End If
Next j
Next i
End Sub