Unmerge Cells And Fill With Duplicate Data With VBA Code

Source :

Sub UnMergeSameCell()

'Upadateby20131127

Dim Rng As Range, xCell As Range

xTitleId = "KutoolsforExcel"

Set WorkRng = Application.Selection

Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)

Application.ScreenUpdating = False

Application.DisplayAlerts = False

For Each Rng In WorkRng

    If Rng.MergeCells Then

        With Rng.MergeArea

            .UnMerge

            .Formula = Rng.Formula

        End With

    End If

Next

Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Sub