Code to cut all column values & place them under one column

[panyagak]

Hi MrExcel

I have a large Excel sheet with common row
headers but with close to 12 columns with
different values. As the row headers are the same,

I need only one column under 1st of the 12 with all column values under it.

Currently, I copy the common rows & columns & paste them downwards 11 times, then cut all values in each column & paste them downwards, again 11 times so that am left with ONLY ONE column for quick sorting. ITS TIRESOME though safer for me.

How can I simplify this with a code?

HELP!!!

 

[panyagak]

Joe4.

Next row after Class8.

Sorry, though had mentioned " values in columns M to last" - so I merely restricted myself to M - U. By "last", I meant even up to column Z.

Regards

 

[Joe4]

Let me try my last question again, as this is important and affects how I write the code.
Does your very first row of data start on line one or another row?

 

[panyagak]

Row 2!

 

[Joe4]

Try this:

Sub MyCopyColumnsData()

    Dim firstRow As Long
    Dim lastRow As Long
    Dim numRows As Long
    Dim counter As Long
    Dim lastCol As Long
    Dim myCol As Long
    
    Application.ScreenUpdating = False
    
'   *****Specify where first row of data starts*****
    firstRow = 2
        
'   Find last row with data in column A
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Calculate the total number of rows
    numRows = lastRow - firstRow + 1
    
'   Find last column with data in row 1
    lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
    
'   Set default value of counter
    counter = 1
    
'   Loop through all columns, starting with column L (column 12)
    For myCol = 13 To lastCol
'       Copy columns A-K first
        Range(Cells(firstRow, "A"), Cells(lastRow, "K")).Copy Cells((numRows * counter) + firstRow, "A")
'       Copy next column to column L
        Range(Cells(firstRow, myCol), Cells(lastRow, myCol)).Cut Cells((numRows * counter) + firstRow, "L")
'       Increment counter
        counter = counter + 1
    Next myCol
    
    Application.ScreenUpdating = True
    
End Sub

 

[panyagak]

Joe4.

I'll try it out in the course of the week.

Thanks

 

[panyagak]

Joe4

Thanks, though late, this code works GREAT & IS ADJUSTABLE (see below) to suit various worksheets.

Regards

Sub MyCopyColumnsData()

Dim firstRow As Long
Dim lastRow As Long
Dim numRows As Long
Dim counter As Long
Dim lastCol As Long
Dim myCol As Long

Application.ScreenUpdating = False

' *****Specify where first row of data starts*****
firstRow = 2

' Find last row with data in column A
lastRow = Cells(Rows.Count, "A").End(xlUp).Row

' Calculate the total number of rows
numRows = lastRow - firstRow + 1

' Find last column with data in row 1
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column

' Set default value of counter
counter = 1

' Loop through all columns, starting with column L (column 12)
For myCol = 23 To lastCol
' Copy columns A-U first
Range(Cells(firstRow, "A"), Cells(lastRow, "U")).Copy Cells((numRows * counter) + firstRow, "A")
' Copy next column to column U
Range(Cells(firstRow, myCol), Cells(lastRow, myCol)).Cut Cells((numRows * counter) + firstRow, "W")
' Increment counter
counter = counter + 1
Next myCol

Application.ScreenUpdating = True

End Sub

 

[Joe4]

You are welcome. Glad it worked out for you.

 

[panyagak]

Sub MyCopyColumnsData()


Dim firstRow As Long
Dim lastRow As Long
Dim numRows As Long
Dim counter As Long
Dim lastCol As Long
Dim myCol As Long

Application.ScreenUpdating = False

' *****Specify where first row of data starts*****
firstRow = 2

' Find last row with data in column A
lastRow = Cells(Rows.Count, "A").End(xlUp).Row

' Calculate the total number of rows
numRows = lastRow - firstRow + 1

' Find last column with data in row 1
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column

' Set default value of counter
counter = 1

' Loop through all columns, starting with column Y (column 25)
For myCol = 26 To lastCol
' Copy columns A-K first
Range(Cells(firstRow, "A"), Cells(lastRow, "X")).Copy Cells((numRows * counter) + firstRow, "A")
' Copy next column to column L
Range(Cells(firstRow, myCol), Cells(lastRow, myCol)).Cut Cells((numRows * counter) + firstRow, "Y")
' Increment counter
counter = counter + 1
Next myCol

Application.ScreenUpdating = True

End Sub

 

[panyagak]

Joe4

Please help here.

Am trying to run this code on this SAMPLE data without success:
Data A to Z to copy/paste downwards & values Z to AG to cut/paste downwards under column Y.

INDI/(BD2/CF)/BD4/TD3/TD2/TD1	Z	AA	AB	AC	AD	AE	AF	AG
12.0022285	1.20	0.12	0.01	120.02	1,200.22	12,002.23	120,022.28	1,200,222.85
32.8453377	3.28	0.33	0.03	328.45	3,284.53	32,845.34	328,453.38	3,284,533.77
6.6436289	0.66	0.07	0.01	66.44	664.36	6,643.63	66,436.29	664,362.89
59.3376378	5.93	0.59	0.06	593.38	5,933.76	59,337.64	593,376.38	5,933,763.78
0.7543308	0.08	0.01	0.00	7.54	75.43	754.33	7,543.31	75,433.08
31.2962455	3.13	0.31	0.03	312.96	3,129.62	31,296.25	312,962.46	3,129,624.55
0.2937732	0.03	0.00	0.00	2.94	29.38	293.77	2,937.73	29,377.32
80.3603747	8.04	0.80	0.08	803.60	8,036.04	80,360.37	803,603.75	8,036,037.47
0.5946359	0.06	0.01	0.00	5.95	59.46	594.64	5,946.36	59,463.59
0.9234962	0.09	0.01	0.00	9.23	92.35	923.50	9,234.96	92,349.62

<colgroup><col><col span="6"><col><col></colgroup><tbody>
</tbody>

Sub MyCopyColumnsData()


Dim firstRow As Long
Dim lastRow As Long
Dim numRows As Long
Dim counter As Long
Dim lastCol As Long
Dim myCol As Long

Application.ScreenUpdating = False

' *****Specify where first row of data starts*****
firstRow = 2

' Find last row with data in column A
lastRow = Cells(Rows.Count, "A").End(xlUp).Row

' Calculate the total number of rows
numRows = lastRow - firstRow + 1

' Find last column with data in row 1
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column

' Set default value of counter
counter = 1

' Loop through all columns, starting with column Y (column 25)
For myCol = 26 To lastCol
' Copy columns A-K first
Range(Cells(firstRow, "A"), Cells(lastRow, "X")).Copy Cells((numRows * counter) + firstRow, "A")
' Copy next column to column Y
Range(Cells(firstRow, myCol), Cells(lastRow, myCol)).Cut Cells((numRows * counter) + firstRow, "Y")
' Increment counter
counter = counter + 1
Next myCol

Application.ScreenUpdating = True

End Sub


Regards
Patrick

 

[panyagak]

Sorry:

Data A to X to copy/paste downwards & values Z to AG to cut/paste downwards under column Y.