Transpose to break up one long row to many?
 

Hi All
I have a problem i hope you can help with. The sheet i have has rows of many
columns, what i need to do is leave the first 5 columns of data and
underneath that row insert the next 5 columns of data, then the same again
with 4 columns, 5 columns, 4 columns. One the has done move to the next
original row and repeat till the end. Any suggestiosn on a macro to help?
Thanks

Transpose to break up one long row to many?
 

Try this to move in blocks of 5

Option Explicit
Sub breakrowtorows()
Dim i As Long
Dim j As Long
Dim r As Long

Application.ScreenUpdating = False
For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
r = 1
For j = 1 To Cells(i, Columns.Count).End(xlToLeft).Column Step 5
Cells(i, j).Resize(, 5).Copy
Cells(i + r, 1).Insert Shift:=xlDown
r = r + 1
Next j
Rows(i).Delete
Next i
Application.ScreenUpdating = True
End Sub


--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Andym" wrote in message
...
Hi All
I have a problem i hope you can help with. The sheet i have has rows of
many
columns, what i need to do is leave the first 5 columns of data and
underneath that row insert the next 5 columns of data, then the same again
with 4 columns, 5 columns, 4 columns. One the has done move to the next
original row and repeat till the end. Any suggestiosn on a macro to help?
Thanks

Transpose to break up one long row to many?
 

'You could try this one. Note that you need to state what rows range to
cover. It
'currently is set to transpose rows 4 through 5

'===============
Sub Reorder()
Dim i, x, j, xOffset As Double

'Which rows to transpose?
For i = 5 To 4 Step -1

x = 6
j = 10
xOffset = 1
'Go until the 23rd column of data
While j < 23

Range(Cells(i, x), Cells(i, j)).Cut
Cells(i + xOffset, "A").Insert shift:=xlDown
If j - x = 3 Then
'If a shorter segment, shift leftover cells
Cells(i + xOffset, 5).Insert shift:=xlDown
End If
'alternate grabbing 4 of 5 columns
If j - x = 4 Then
x = j + 1
j = x + 3
Else
x = j + 1
j = x + 4
End If
xOffset = xOffset + 1
Wend
Next
End Sub
'================
--
Best Regards,

Luke M
*Remember to click "yes" if this post helped you!*


"Andym" wrote:

Hi All
I have a problem i hope you can help with. The sheet i have has rows of many
columns, what i need to do is leave the first 5 columns of data and
underneath that row insert the next 5 columns of data, then the same again
with 4 columns, 5 columns, 4 columns. One the has done move to the next
original row and repeat till the end. Any suggestiosn on a macro to help?
Thanks