Вот способ сделать это в VBA (при условии, что данные находятся в столбце A
):
Option Explicit
Sub movetocolumns()
Dim i As Integer, iRow As Integer
Dim arrSource As Variant
'Set the first row
iRow = 1
With ActiveWorkbook.Worksheets("Sheet1")
'get the data into an array from the first column
arrSource = Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
'parse every value of the array and add the data to the next column
For i = 1 To (UBound(arrSource) - UBound(arrSource) Mod 3) Step 3
.Cells(iRow, 2) = arrSource(i, 1)
.Cells(iRow, 3) = arrSource(i + 1, 1)
.Cells(iRow, 4) = arrSource(i + 2, 1)
iRow = iRow + 1
Next i
'add the remaining values
Select Case UBound(arrSource) Mod 3
Case 1 'one item to add
.Cells(iRow, 2) = arrSource(i, 1)
Case 2 'still two items to add
.Cells(iRow, 2) = arrSource(i, 1)
.Cells(iRow, 3) = arrSource(i + 1, 1)
Case Else 'nothing to add
End Select
End With
End Sub