ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   merge columns (https://www.excelbanter.com/excel-programming/384688-merge-columns.html)

Vlad

merge columns
 
I have 10+ columns of data. I need to have all columns merged one under
another into one column.For example column A. I can do it manually by cutting
the data in each column and pasting it below the last record in column A. But
there should be a way to automate that.Any help with the code will be
apprciated

Chip Pearson

merge columns
 
Try something like the following, where

C_COLUMNS_TO_MERGE
is the number of columns to merge

C_START_COLUMN
is the first column of data to merge

C_START_ROW
is the row to start on.

The procedure will start with row C_START_ROW and continue downwards until
an empty cell is encountered in C_START_COLUMN.


Sub MergeThem()

Const C_COLUMNS_TO_MERGE = 3
Const C_START_COLUMN = 1
Const C_START_ROW = 2

Dim S As String
Dim Ndx As Long
Dim Rng As Range

Set Rng = ActiveSheet.Cells(C_START_ROW, C_START_COLUMN)
Application.DisplayAlerts = False
Do Until Rng.Value = vbNullString
S = vbNullString
For Ndx = 1 To C_COLUMNS_TO_MERGE
S = S & Rng(1, Ndx).Text & IIf(Ndx < C_COLUMNS_TO_MERGE, " ", "")
Next Ndx
Rng.Resize(1, C_COLUMNS_TO_MERGE).Merge
Rng.Value = S

Set Rng = Rng(2, 1)
Loop
Application.DisplayAlerts = True

End Sub


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
(email address is on the web site)


"vlad" wrote in message
...
I have 10+ columns of data. I need to have all columns merged one under
another into one column.For example column A. I can do it manually by
cutting
the data in each column and pasting it below the last record in column A.
But
there should be a way to automate that.Any help with the code will be
apprciated




Gord Dibben

merge columns
 
vlad

Try this from Bernie Dietrick

Sub OneColumnV2()
''''''''''''''''''''''''''''''''''''''''''
'Macro to copy columns of variable length'
'into 1 continous column in a new sheet '
'Modified 17 FEb 2006 by BD
''''''''''''''''''''''''''''''''''''''''''
Dim iLastcol As Long
Dim iLastRow As Long
Dim jLastrow As Long
Dim ColNdx As Long
Dim WS As Worksheet
Dim myRng As Range
Dim ExcludeBlanks As Boolean
Dim myCell As Range

ExcludeBlanks = (MsgBox("Exclude Blanks", vbYesNo) = vbYes)
Set WS = ActiveSheet
iLastcol = WS.Cells(1, WS.Columns.Count).End(xlToLeft).Column
On Error Resume Next

Application.DisplayAlerts = False
Worksheets("Alldata").Delete
Application.DisplayAlerts = True

Sheets.Add.Name = "Alldata"

For ColNdx = 1 To iLastcol

iLastRow = WS.Cells(WS.Rows.Count, ColNdx).End(xlUp).Row

Set myRng = WS.Range(WS.Cells(1, ColNdx), _
WS.Cells(iLastRow, ColNdx))

If ExcludeBlanks Then
For Each myCell In myRng
If myCell.Value < "" Then
jLastrow = Sheets("Alldata").Cells(Rows.Count, 1) _
.End(xlUp).Row
myCell.Copy
Sheets("Alldata").Cells(jLastrow + 1, 1) _
.PasteSpecial xlPasteValues
End If
Next myCell
Else
myRng.Copy
jLastrow = Sheets("Alldata").Cells(Rows.Count, 1) _
.End(xlUp).Row
myCell.Copy
Sheets("Alldata").Cells(jLastrow + 1, 1) _
.PasteSpecial xlPasteValues
End If
Next

Sheets("Alldata").Rows("1:1").EntireRow.Delete

WS.Activate
End Sub


Gord Dibben MS Excel MVP

On Tue, 6 Mar 2007 16:16:03 -0800, vlad wrote:

I have 10+ columns of data. I need to have all columns merged one under
another into one column.For example column A. I can do it manually by cutting
the data in each column and pasting it below the last record in column A. But
there should be a way to automate that.Any help with the code will be
apprciated



dantuck

merge columns
 
Hello,

This might do what you're after - but make sure the data starts in cell A1.

Dan.

Option Explicit

Sub ToOneColumn()

Dim cntI As Integer
Dim cntJ As Integer
Dim TotalRows As Integer
Dim TotalCols As Integer

TotalRows = ActiveSheet.UsedRange.Rows.Count
TotalCols = ActiveSheet.UsedRange.Columns.Count

For cntJ = 2 To TotalCols

Cells(1, cntJ).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Cells((cntJ - 1) * TotalRows + 1, 1).Select
ActiveSheet.Paste

Next cntJ

Cells(1, 1).Select

End Sub



"vlad" wrote:

I have 10+ columns of data. I need to have all columns merged one under
another into one column.For example column A. I can do it manually by cutting
the data in each column and pasting it below the last record in column A. But
there should be a way to automate that.Any help with the code will be
apprciated



All times are GMT +1. The time now is 02:39 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com