View Single Post
 
Old 11-09-2015, 03:02 AM
Debaser's Avatar
Debaser Debaser is offline Windows 7 64bit Office 2010 32bit
Competent Performer
 
Join Date: Oct 2015
Location: UK
Posts: 221
Debaser will become famous soon enough
Default

You could do this:

Code:
Sub resizeMerge()

    Dim lRow                  As Long
    Dim lCount                As Long
    Dim lLastRow              As Long

    lRow = 1

    ' change to your last row
    lLastRow = 25

    Do While lRow <= lLastRow
        With Cells(lRow, "A")
            If .MergeCells Then
                lCount = .MergeArea.Cells.Count
                .UnMerge
                If lCount > 2 Then .Resize(lCount - 1).Merge
            End If
        End With
        lRow = lRow + lCount
    Loop
End Sub
Reply With Quote