Merge two colums in one one below other.

[sakis_s]

Hi!
How can i turn this (Columns A & B):

1	A
2	B
3	C

into this (Column C):

1

2

3

A

B

C

Thank you in advance for your help!

 

[sakis_s]

Change "A:C" for the columns you want to join. The union will be in the next column.

Sub Merge_Columns()
  Dim j As Range, r As Range
  Dim lr1 As Long, lr2 As Long
 
  lr2 = 1
  Set r = Range("A:C")      'columns to merge
  For Each j In r.Columns
    lr1 = Cells(Rows.Count, j.Column).End(3).Row
    r.Cells(lr2, r.Columns.Count + 1).Resize(lr1).Value = j.Range(Cells(1, 1), Cells(lr1, 1)).Value
    lr2 = r.Cells(Rows.Count, r.Columns.Count + 1).End(3).Row + 1
  Next
End Sub

Thank you very much DanteAmor!
What if columns are not in the row and i want to join for example column A, column J and column Z to AA Column?
Your help is really appreciated!

 

[DanteAmor]

join for example column A, column J and column Z to AA Column

Try this:

Sub Merge_Columns()
  Dim j As Range, r As Range
  Dim lr1 As Long, lr2 As Long
  Dim col As String
  
  lr2 = 1
  Set r = Range("A:A, J:J, Z:Z")      'columns to join
  col = "AA"                          'detination column
  
  For Each j In r.Columns
    lr1 = Cells(Rows.Count, j.Column).End(3).Row
    r.Cells(lr2, col).Resize(lr1).Value = j.Range(Cells(1, 1), Cells(lr1, 1)).Value
    lr2 = r.Cells(Rows.Count, col).End(3).Row + 1
  Next
End Sub

 

[sakis_s]

Try this:

Sub Merge_Columns()
  Dim j As Range, r As Range
  Dim lr1 As Long, lr2 As Long
  Dim col As String
 
  lr2 = 1
  Set r = Range("A:A, J:J, Z:Z")      'columns to join
  col = "AA"                          'detination column
 
  For Each j In r.Columns
    lr1 = Cells(Rows.Count, j.Column).End(3).Row
    r.Cells(lr2, col).Resize(lr1).Value = j.Range(Cells(1, 1), Cells(lr1, 1)).Value
    lr2 = r.Cells(Rows.Count, col).End(3).Row + 1
  Next
End Sub

It is strange. If i keep the code as is, it merges A, J & Z columns.
But if i change the columns to Z, AE & AJ which is what i need it doesn't bring any results.

 

[DanteAmor]

I forgot to remove the range r.

Try this:

Sub Merge_Columns()
  Dim j As Range, r As Range
  Dim lr1 As Long, lr2 As Long
  Dim col As String
  
  lr2 = 1
  Set r = Range("Z:Z, AE:AE, AJ:AJ")      'columns to join
  col = "AA"                              'detination column
  
  For Each j In r.Columns
    lr1 = Cells(Rows.Count, j.Column).End(3).Row
    Cells(lr2, col).Resize(lr1).Value = j.Range(Cells(1, 1), Cells(lr1, 1)).Value
    lr2 = Cells(Rows.Count, col).End(3).Row + 1
  Next
End Sub

 

[sakis_s]

I forgot to remove the range r.

Try this:

Sub Merge_Columns()
  Dim j As Range, r As Range
  Dim lr1 As Long, lr2 As Long
  Dim col As String
 
  lr2 = 1
  Set r = Range("Z:Z, AE:AE, AJ:AJ")      'columns to join
  col = "AA"                              'detination column
 
  For Each j In r.Columns
    lr1 = Cells(Rows.Count, j.Column).End(3).Row
    Cells(lr2, col).Resize(lr1).Value = j.Range(Cells(1, 1), Cells(lr1, 1)).Value
    lr2 = Cells(Rows.Count, col).End(3).Row + 1
  Next
End Sub

This works perfectly!
Just one more little thing if possible. My data on columns begin from 5th row so this also brings five empty cells from each column when it merges the data.
I'tried

Set r = Range("Z5:Z, AE5:AE, AJ5:AJ")

but thing returns "Run-time error 1004" when running the script.

Is it easy to begin from 5th row?

 

[DanteAmor]

My data on columns begin from 5th row

I made some changes to put the starting row of origin and the starting row of destination.

Sub Merge_Columns()
  Dim j As Range, r As Range
  Dim lr1 As Long, lr2 As Long, ini As Long
  Dim col As String
 
  Set r = Range("Z:Z, AE:AE, AJ:AJ")      'columns to join
  ini = 5                                 'row start origen
  col = "AA"                              'detination column
  lr2 = 5                                 'row start destination
 
  For Each j In r.Columns
    lr1 = WorksheetFunction.Max(Cells(Rows.Count, j.Column).End(3).Row, ini)
    Cells(lr2, col).Resize(lr1 - (ini - 1)).Value = j.Range(Cells(ini, 1), Cells(lr1, 1)).Value
    lr2 = WorksheetFunction.Max(Cells(Rows.Count, col).End(3).Row + 1, lr2)
  Next
End Sub

 

[sakis_s]

I made some changes to put the starting row of origin and the starting row of destination.

Sub Merge_Columns()
  Dim j As Range, r As Range
  Dim lr1 As Long, lr2 As Long, ini As Long
  Dim col As String
 
  Set r = Range("Z:Z, AE:AE, AJ:AJ")      'columns to join
  ini = 5                                 'row start origen
  col = "AA"                              'detination column
  lr2 = 5                                 'row start destination
 
  For Each j In r.Columns
    lr1 = WorksheetFunction.Max(Cells(Rows.Count, j.Column).End(3).Row, ini)
    Cells(lr2, col).Resize(lr1 - (ini - 1)).Value = j.Range(Cells(ini, 1), Cells(lr1, 1)).Value
    lr2 = WorksheetFunction.Max(Cells(Rows.Count, col).End(3).Row + 1, lr2)
  Next
End Sub

You are truly amazing DanteAmor! Thank you so much! I really appreciate your help!
All best!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.