Merging Cells in Multiple Columns with a Macro

Copper Contributor

 

Hello,

 

I'm trying to create a macro where it merges the same amount of cells from the same rows on 4 different columns next to each other. 

 

In the example below, when I select and merge A1:A4, I would want the macro to automatically merge the originally selected cells (in this case A1:A4) and then also merge B1:B4, C1:C4, and D1:D4. It will always be 3 columns to merge after the first one so 4 columns in total. However, the number of cells will vary (Ex.: it can be A1:A2 or A1:A5).

Before running macroBefore running macro

Desired result after running macroDesired result after running macro

 I tried recording my own macro but it wasn't working the way I wanted it to. The 3 other columns weren't merging relative to the number of rows of the first column. They were always merging the same rows that I recorded with the macro instead of being relative to the rows selected on the first column (even though relative reference was turned on). Please see below the macro that I recorded.

Sub Macro22()
'
' Macro22 Macro
'
' Keyboard Shortcut: Ctrl+l
'
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    ActiveCell.Offset(0, 1).Range("A1:A4").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    ActiveCell.Offset(0, 1).Range("A1:A4").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    ActiveCell.Offset(0, 1).Range("A1:A4").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
End Sub

 

You can see below that the 3 other columns always merge the same amount of rows regardless of the number of rows I originally selected in the first column.

Capture3.PNG

Capture4.PNG

Capture5.PNG

 

Thanks in advance. Any help is appreciated.

David

  

  

1 Reply

@David1405 Try this one:

Sub Macro1()

ro = Selection.Rows.Count
acr = ActiveCell.Row
acc = ActiveCell.Column

For i = 0 To 3
    
    Range(Cells(acr, acc + i), Cells(acr + ro, acc + i)).Select

    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
  Next
  
  End Sub