Splitting Row of 45 cells into 3 rows of 15 cells

[AegonFlow]

Hi all

I have a data set that resembles something similar to this:

ID
1 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
2 ………………...………………………………………......……………………………………......……………...………...…………………………………..
3 ………………………………………………………………………………………………………………………………...…………………………………...
.
.
.
60 ……………………………………………………………………………………………………………...……………………………………………………….

I have 60 participants and for each one they have 45 different data values. Each of the values in the row in in a separate column. I am trying to re order this so as opposed to one long row of 45 columns of data points, I split it into 3 Rows of 15 data points resembling this format:

ID
1 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
1 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
1 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
2
2
2
3
3
3
.
.
.
.
60

So effectively I want to split the row at the 15th column twice to give me three rows. I have found a syntax that was attempting a similar issue and tried to use this, however although it splits my value at each 15th one it inserts the new row only in the first column not into 15 separate ones. The syntax is as follows:

Could anyone please offer some advice to how to either change this code to output into 15 separate columns not just first column or offer advice on an alternative method/code to get this results.

Any guidance would be wholly appreciated

Cheers

AegonFlow

 

[Joe4]

Assuming that your ID is in column A, and the data to split start in column B, and the data starts on row 1, try this code:

Sub MyDataSplitter()

    Dim r As Long
   
    Application.ScreenUpdating = False
   
'   Set starting row
    r = 1

'   Loop through all rows
    Do
'       Check current row, and if blank, exit loop
        If Cells(r, "A") = "" Then Exit Do

'       Insert two blank lines under current row
        Rows(r + 1 & ":" & r + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'       Copy column A down
        Range(Cells(r + 1, "A"), Cells(r + 2, "A")).Value = Cells(r, "A").Value
'       Cut data from columns 17:31 to next row
        Range(Cells(r, 17), Cells(r, 31)).Cut Cells(r + 1, 2)
'       Cut data from column 32:46 to next row
        Range(Cells(r, 32), Cells(r, 46)).Cut Cells(r + 2, 2)
'       Add three to r to move down to next row to split
        r = r + 3
    Loop

    Application.ScreenUpdating = True
   
    MsgBox "Macro complete!", vbOKOnly
   
End Sub

 

[AegonFlow]

That has worked perfectly! Thankyou so much for your help Joe4, much appreciated!

 

[Joe4]

You are welcome.
Glad I was able to help!