Copy and paste data in multiple columns in to one column

MrPink1986

Active Member
Joined
May 1, 2012
Messages
252
Hi there,

I have data in multiple columns on Sheet "Fields" - from A-AS. Each column varies in data and has 1-100 rows populated.
I wish to take all this data from these columns and paste them into one column on the "Sheet3" tab.

On the fields tab there is a header row which I do not require - how would i best approach this?
I need some type of loop to go though the columns on the fields tab I guess?

Thanks in advance for the help.
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
When you say:
Each column varies in data
do you mean that they all have the same number of rows populated but the number of rows can vary or do you mean that each column can have a different number of rows populated?
 
Upvote 0
Give this a go
Code:
Sub Consolidate()
    Dim FromSheet, ToSheet As Worksheet
    Dim LastRow, ColumnNumber As Integer
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    Set FromSheet = ThisWorkbook.Sheets("Fields")
    Set ToSheet = ThisWorkbook.Sheets("Sheet3")
    
    LastRow = 2
    
    For ColumnNumber = 1 To 45
        With FromSheet
            .Range(.Cells(2, ColumnNumber), .Cells(.Cells(Rows.Count, ColumnNumber).End(xlUp).Row, ColumnNumber)).Copy
        End With
        ToSheet.Cells(LastRow, 1).PasteSpecial xlPasteValues
        LastRow = ToSheet.Cells(2, 1).End(xlDown).Row + 1
    Next ColumnNumber
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub
 
Upvote 0
This has worked perfectly for me thanks so much ;)
Give this a go
Code:
Sub Consolidate()
    Dim FromSheet, ToSheet As Worksheet
    Dim LastRow, ColumnNumber As Integer
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    Set FromSheet = ThisWorkbook.Sheets("Fields")
    Set ToSheet = ThisWorkbook.Sheets("Sheet3")
    
    LastRow = 2
    
    For ColumnNumber = 1 To 45
        With FromSheet
            .Range(.Cells(2, ColumnNumber), .Cells(.Cells(Rows.Count, ColumnNumber).End(xlUp).Row, ColumnNumber)).Copy
        End With
        ToSheet.Cells(LastRow, 1).PasteSpecial xlPasteValues
        LastRow = ToSheet.Cells(2, 1).End(xlDown).Row + 1
    Next ColumnNumber
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub
 
Upvote 0

Forum statistics

Threads
1,203,046
Messages
6,053,191
Members
444,644
Latest member
keepontruckinc4

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top