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

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
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,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

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