Macro to combine columns without formulas

[decadence]

Good Morning all,

I need a macro to combine any columns I select into one column, so if I chose columns A,B,C,D then all data from these columns will be merged into column A with a space, or if I selected Columns D to T then all data from columns D to T would be merged into column D with a space,

Each column must keep the original data on the same row and the columns originally selected are deleted after merging.
Each Column will have varied data with different number of rows
Headers are to be included with this merge
I am using Excel 2007

(Note: the full stops used don't mean anything apart from to break up text)

Example

.......A........B.........C.........D..........E
1 Hi.......How......Are......You......Hello
2 ..........How
3 ......................Are
4 ................................You

Merged to this

.............A...................B.........C........D.........E
1 Hi How Are You.....Hello
2 How
3 Are
4 You

Any help is appreciated,

Thanks in advance

 

[Peter_SSs]

Test in a copy of your workbook

Sub Combine()
  Dim a, b
  Dim i As Long
  
  With Intersect(ActiveSheet.UsedRange, Selection)
    a = .Value
    ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
    For i = 1 To UBound(a, 1)
      b(i, 1) = Application.Trim(Join(Application.Index(a, i, 0)))
    Next i
    .Value = b
    .EntireColumn.AutoFit
  End With
End Sub

 

[decadence]

Hi Peter, this code does exactly what I need, However can it be modified so it deletes the empty columns as well, so in the case of the example previously posted Columns A to D had data in, after the merge columns B to D were empty but still present. thanks

 

[Peter_SSs]

Hi Peter, this code does exactly what I need, However can it be modified so it deletes the empty columns as well, so in the case of the example previously posted Columns A to D had data in, after the merge columns B to D were empty but still present. thanks

Sure

Sub Combine()
  Dim a
  Dim i As Long
  
  With Intersect(ActiveSheet.UsedRange, Selection)
    a = .Value
    For i = 1 To UBound(a, 1)
      a(i, 1) = Application.Trim(Join(Application.Index(a, i, 0)))
    Next i
    .Value = a
    .Columns(1).EntireColumn.AutoFit
    .Offset(, 1).Resize(UBound(a, 2) - 1).EntireColumn.Delete
  End With
End Sub

 

[decadence]

Hi Peter, the delete code part doesn't quite work, It deletes columns B to E rather than B to D.
Thanks

 

[Peter_SSs]

Hi Peter, the delete code part doesn't quite work, It deletes columns B to E rather than B to D.
Thanks

Sorry, I was missing a comma

.Offset(, 1).Resize(, UBound(a, 2) - 1).EntireColumn.Delete

 

[decadence]

Works Perfectly Peter, Many thanks for your help

 

[Peter_SSs]

Works Perfectly Peter, Many thanks for your help

You are very welcome. Thanks for the follow-up.