A Macro to move data from rows to columns Solved/Closed

Question

Hello,  

I have data in a single column and would like to copy it into a rows for every x rows, for example; The column of data varies in the amount of data each time.  

A
1 
2 
3 
4 
5 
6 
7 
8 
9 
10 
11 
12 
13 
etc  

into  

for every x=4 rows 
C D E  F
1 5  9 13 
2 6 10 ect 
3 7 11 
4 8 12 

  

Thank you in advance for any advise or solution that will help me solve this issue.  
Kris 

Configuration: Windows 7 / Chrome 21.0.1180.79

venkat1926 · Answer

suppose he main data is from A1 down (no column heading)

now try this macro 


Sub test()
Dim j As Integer, lastrow As Integer, m As Integer
Dim r As Range, r1 As Range, r2 As Range
lastrow = Range("A1").End(xlDown).Row
Range(Range("C1"), Range("C1").End(xlToRight)).EntireColumn.Delete

j = 1
m = 0
Set r1 = Range("a1")
Set r2 = Range("C1")
Do
If r1 > 4 Then Exit Do

Set r = r1.Offset(4 * (j - 1), 0)
'MsgBox r1 & " " & r
r.Copy r2.Offset(0, m)
j = j + 1
m = m + 1
If r = "" Then
Set r1 = r1.Offset(1, 0)
Set r2 = r2.Offset(1, 0)
j = 1: m = 0
End If
Loop

Arnold2222 · Answer

Amazing!!

This is what I need :)

Thank you so much, I am really glad for your help!

venkat1926 · Answer

welcome

Arnold2222 · Answer

Hello again Venkat I would like to ask you for advice,
this macro is working amazing wiht numbers but if there will appear some text+numbers it fail :(
where we should make a fix to make it work again with text+numbers or text only ?

Thank you in advance :)

venkat1926 · Answer

depends upon interpretation

try this macro see the result. tell me if you want any change in the result 

your data is from A1

a
s
d
f
g
h
j
k
l
q
w
e
r
t


the macro is 


Sub test()
Dim j As Integer, lastrow As Integer, m As Integer
Dim r As Range, r1 As Range, r2 As Range
lastrow = Range("A1").End(xlDown).Row
Range(Range("C1"), Range("C1").End(xlToRight)).EntireColumn.Delete

j = 1
m = 0
Set r1 = Range("a1")
Set r2 = Range("C1")
Do
'If r1 > 4 Then Exit Do

Set r = r1.Offset(4 * (j - 1), 0)
'MsgBox r1 & " " & r
If r2.Offset(0, m).Row > Range("a1").End(xlDown).Row Then Exit Do
r.Copy r2.Offset(0, m)

j = j + 1
m = m + 1
If r = "" Then
Set r1 = r1.Offset(1, 0)
Set r2 = r2.Offset(1, 0)
j = 1: m = 0
End If
Loop
End Sub

Arnold2222 · Answer

Hi :)
Thank you for fast answer!

Unfortunately as the resul I get:


ax4dd		ax4dd	asd24	asd46d	567ert	678nv	897fffh	456dg	4dbvdg	546vvbn
xa4aas		xa4aas	123asd	345gh	345cvb	35sdgf	3456dg	3453dgd	223sfsdf	456ffh
as234		as234	234af	456sdf	47dfg	456dfbv	24ffs	234ssfd	57dgdfg	2swww
ads123		ads123	423asd	345cb	456dvg	456sdf	456vbdd	34534sfs	456dddg	fgh678
asd24		asd24	asd46d	567ert	678nv	897fffh	456dg	4dbvdg	546vvbn	
123asd		123asd	345gh	345cvb	35sdgf	3456dg	3453dgd	223sfsdf	456ffh	
234af		234af	456sdf	47dfg	456dfbv	24ffs	234ssfd	57dgdfg	2swww	
423asd		423asd	345cb	456dvg	456sdf	456vbdd	34534sfs	456dddg	fgh678	
asd46d		asd46d	567ert	678nv	897fffh	456dg	4dbvdg	546vvbn		
345gh		345gh	345cvb	35sdgf	3456dg	3453dgd	223sfsdf	456ffh		
456sdf		456sdf	47dfg	456dfbv	24ffs	234ssfd	57dgdfg	2swww		
345cb		345cb	456dvg	456sdf	456vbdd	34534sfs	456dddg	fgh678		
567ert		567ert	678nv	897fffh	456dg	4dbvdg	546vvbn			
345cvb		345cvb	35sdgf	3456dg	3453dgd	223sfsdf	456ffh			
47dfg		47dfg	456dfbv	24ffs	234ssfd	57dgdfg	2swww			
456dvg		456dvg	456sdf	456vbdd	34534sfs	456dddg	fgh678			
678nv		678nv	897fffh	456dg	4dbvdg	546vvbn				
35sdgf		35sdgf	3456dg	3453dgd	223sfsdf	456ffh				
456dfbv		456dfbv	24ffs	234ssfd	57dgdfg	2swww				
456sdf		456sdf	456vbdd	34534sfs	456dddg	fgh678				
897fffh		897fffh	456dg	4dbvdg	546vvbn					
3456dg		3456dg	3453dgd	223sfsdf	456ffh					
24ffs		24ffs	234ssfd	57dgdfg	2swww					
456vbdd		456vbdd	34534sfs	456dddg	fgh678					
456dg		456dg	4dbvdg	546vvbn						
3453dgd		3453dgd	223sfsdf	456ffh						
234ssfd		234ssfd	57dgdfg	2swww						
34534sfs		34534sfs	456dddg	fgh678						
4dbvdg		4dbvdg	546vvbn							
223sfsdf		223sfsdf	456ffh							
57dgdfg		57dgdfg	2swww							
456dddg		456dddg	fgh678							
546vvbn		546vvbn								
456ffh		456ffh								
2swww		2swww								
fgh678		fgh678

The result should be smth like:

ax4dd		ax4dd	123asd	456sdf	456dvg	897fffh	3453dgd	57dgdfg
xa4aas		xa4aas	234af	345cb	678nv	3456dg	234ssfd	456dddg
as234		as234	423asd	567ert	35sdgf	24ffs	34sfs	546vvbn
ads123		ads123	asd46d	345cvb	456dfbv	456vbdd	4dbvdg	456ffh
asd24		asd24	345gh	47dfg	456sdf	456dg	223sfs	2swww
123asd								
234af								
423asd								
asd46d								
345gh								
456sdf								
345cb								
567ert								
345cvb								
47dfg								
456dvg								
678nv								
35sdgf								
456dfbv								
456sdf								
897fffh								
3456dg								
24ffs								
456vbdd								
456dg								
3453dgd								
234ssfd								
34sfs								
4dbvdg								
223sfs								
57dgdfg								
456dddg								
546vvbn								
456ffh								
2swww


Maybe there is little mistake ?

venkat1926 · Answer

send a few rows of your data as they are in your file

Arnold2222 · Answer

like above :) this are similar numbers of data i have in file.

venkat1926 · Answer

macro works for me 

see this webpage

http://speedy.sh/vjwBB/arnold-120914.xlsm

A Macro to move data from rows to columns

9 responses

Similar discussions

Subscribe To Our Newsletter!