Copy data in a row and spread them on separated columns - vba

Question

My row data is as follows:
Column A
Datapoint1
Datapoint2
Datapoint3
Datapoint4
I can transpose, but the result will be like this.
Column A Column B Column C
Datapoint1 Datapoint2 Datapoint3
What I am trying to achieve is
Column A, Column B, Column C, Column D, Column E, Column F, Column G
Datapoint1, empty, empty, empty, empty, empty, Datapoint 2
Datapoint 3 would appear in Column M. There are 5 columns in between.
There are about 3,000 Datapoints that need to be transposed into columns (separated by 5 columns in between).

Answer 1

You can use this function below. I tested it with 3000 items and it ran almost instantly. The problem is after 2732 items, you run out of rows as the Excel maximum column number is 16,384 as of Office 2013 (see Office 2010 Excel Specifications and Office 2013 Excel Specifications). In the code below, once it passes that, it simply clears out the remaining rows and prints a statement to the debug window. Handle this how you want.
Sub TransposeIt()
Const maxColumns As Integer = 16384
On Error GoTo er
Application.ScreenUpdating = False '' shut off screen updating to speed up if possible
Dim x As Range
Set x = Range("A1", Range("A1").End(xlDown)) '' Selects all cells until there is a blank
'' if you might have blanks, then calculate the last row manually
Dim c As Range, col As Integer, val As Variant
For Each c In x.Cells
val = c.Value '' so as not to overwrite A1
c.Value = ""
col = (c.row - 1) * 6 + 1
If col > maxColumns Then '' max number of rows we can actually use is 2732
Debug.Print "Out of Columns, clearing Row " & c.row '' do what you want at this point
Else
Cells(1, col).Value = val
End If
Next
ex:
Application.ScreenUpdating = True
Exit Sub
er:
Debug.Print "An Error has occured: " & Err.Description
Resume ex
End Sub