Select Merged Cells and Unmerge Spread Merge Data To All Cells
 

This is the start:

Sub findmerged()
Dim c
For Each c In ActiveSheet.UsedRange
If c.MergeCells Then
MsgBox c.Address & " is merged"
End If
Next
End Sub

Sub Unmerge()
Dim rng As Range, rngtot As Range, rngval As Variant
Dim strtrow As Long, endrow As Long, col As Long

strtrow = Selection.Row
col = Selection.Column
endrow = Application.WorksheetFunction.Min(Selection.End(xl Down).Row - 1,
Cells(65536, col).End(xlUp).Row + 1)
rngval = Selection.Value

Set rngtot = Range(Cells(strtrow, col), Cells(endrow, col))

ActiveCell.Unmerge
For Each rng In rngtot
rng.Value = rngval
Next rng

End Sub

--
Message posted via http://www.officekb.com

Select Merged Cells and Unmerge Spread Merge Data To All Cells
 

What is the problem you are having? Do you have a question? Indicate where
the error is and what type of error?


--
Cheers,
Ryan


"rtwiss via OfficeKB.com" wrote:

This is the start:

Sub findmerged()
Dim c
For Each c In ActiveSheet.UsedRange
If c.MergeCells Then
MsgBox c.Address & " is merged"
End If
Next
End Sub

Sub Unmerge()
Dim rng As Range, rngtot As Range, rngval As Variant
Dim strtrow As Long, endrow As Long, col As Long

strtrow = Selection.Row
col = Selection.Column
endrow = Application.WorksheetFunction.Min(Selection.End(xl Down).Row - 1,
Cells(65536, col).End(xlUp).Row + 1)
rngval = Selection.Value

Set rngtot = Range(Cells(strtrow, col), Cells(endrow, col))

ActiveCell.Unmerge
For Each rng In rngtot
rng.Value = rngval
Next rng

End Sub

--
Message posted via http://www.officekb.com

Select Merged Cells and Unmerge Spread Merge Data To All Cells
 

trying to select all merged cells on sheet then unmerge each merge cell and
spread merge data to all cells in each merged cell. You follow?

RyanH wrote:
What is the problem you are having? Do you have a question? Indicate where
the error is and what type of error?

This is the start:

[quoted text clipped - 25 lines]

End Sub

--
Message posted via http://www.officekb.com