# insert row under a s selected cell and merge a cells



## anell370 (Dec 19, 2022)

HI
Sorry I'm not familiar with VBA but I need this for my project I need to create VBA button with a code to insert a row under a random selected cell "let's say D" and then merge each of the cellS before it ",C,B,A" with it the new cell inserted under it; for example C2 with C3, B2 with B3 ....keeping the selected one unmegred

THANKS


----------



## tj4242 (Dec 19, 2022)

The horizontal and vertical cell centering should be done before.  And it does some crazy things if you are on a cell that has already been merged.


```
Sub Button1_Click()

    Dim activeC As Long                                                 'The column of the active cell
    Dim col As Long                                                     'a counter
    Dim rng As Range                                                    'range is needed to insert below
    
    activeC = ActiveCell.Column                                         'remember the column with the active cell

    Set rng = ActiveCell.Offset(1, 0)                                   'set up the range
    rng.EntireRow.Select                                                'select that entire row
    Selection.Insert shift:=xlDown                                      'insert below
    
    col = 1                                                             'starting at column A
    While col <= ActiveSheet.UsedRange.Columns.Count                    'go through all columns until done
        If col <> activeC Then                                          'is the current column the one that was active.  If it is do not merge it
            Range(Cells(activeR, col), Cells(activeR + 1, col)).Merge   'merge the cell and the one below it
        End If
        col = col + 1                                                   'move to the next column
    Wend
    
End Sub
```


----------



## anell370 (Dec 26, 2022)

tj4242 said:


> The horizontal and vertical cell centering should be done before.  And it does some crazy things if you are on a cell that has already been merged.
> 
> 
> ```
> ...



Hello,
Thanks a lot for replying but the code doesn't work corractly, it doesn't merge cells it just add a row below, i don't understade why.
thanks


----------



## mumps (Dec 26, 2022)

Try:

```
Sub MergeCells()
    Application.ScreenUpdating = False
    Dim x As Long
    Range("A" & ActiveCell.Row + 1).Insert
    For x = 1 To ActiveCell.Column - 1
        Cells(ActiveCell.Row + 1, x).Resize(2).Merge
    Next x
    Application.ScreenUpdating = True
End Sub
```


----------

