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

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

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