Ummerge then fill all cells with contents of merged cell

caj1980

Board Regular
Joined
Oct 23, 2013
Messages
108
I need a script (macro) that will take all merged cells in a worksheet, unmerge them, then fill them with the text that was in the original merged cell. Multiple unique instances throughout the worksheet. Prefer a solution that would repeat this function for all merged cells within the worksheet.

Sanitized version of my spreadsheet is here:
Dropbox - Public
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
I need a script (macro) that will take all merged cells in a worksheet, unmerge them, then fill them with the text that was in the original merged cell.
I believe this macro will do what you are asking for...
Code:
Sub UnmergeAndFill()
  Application.ScreenUpdating = False
  With ActiveSheet.UsedRange
    .UnMerge
    .SpecialCells(xlBlanks).FormulaR1C1 = "=R[-1]C"
    .Value = .Value
  End With
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
I don't download so haven't seen your file so try this on a copy of your worksheet.
Code:
Sub FindMergedCells()
Dim c As Range, Rws As Long, Cols As Long, mA() As String, ct As Long
Application.ScreenUpdating = False
For Each c In ActiveSheet.UsedRange
    If c.MergeCells Then
        Rws = c.MergeArea.Rows.Count
        Cols = c.MergeArea.Columns.Count
        With c
              .UnMerge
              .Resize(Rws, Cols).Value = .Value
       End With
    End If
Next c
Application.ScreenUpdating = True
End Sub
 
Upvote 0
I don't download so haven't seen your file so try this on a copy of your worksheet.
Code:
Sub FindMergedCells()
Dim c As Range, Rws As Long, Cols As Long, mA() As String, ct As Long
Application.ScreenUpdating = False
For Each c In ActiveSheet.UsedRange
    If c.MergeCells Then
        Rws = c.MergeArea.Rows.Count
        Cols = c.MergeArea.Columns.Count
        With c
              .UnMerge
              .Resize(Rws, Cols).Value = .Value
       End With
    End If
Next c
Application.ScreenUpdating = True
End Sub



This worked great! Thanks, @JoeMo
 
Upvote 0
You are welcome. Did you try Rick's code? If it works, it should be faster than mine.
 
Upvote 0

Forum statistics

Threads
1,223,228
Messages
6,170,875
Members
452,363
Latest member
merico17

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top