CODEWITHSUNDEEP
excelvba
Mindbender
Mindbender

Reputation: 49

Unmerge and copy down across multiple sheets

I found the following code on this site to be very helpful

Public Sub UnmergeAndFill()
    With Selection
        If .MergeCells Then
           .MergeCells = False
           Selection.Cells(1, 1).Copy
           ActiveSheet.Paste 'Or PasteSpecial xlPasteFormulasAndNumberFormats
        End If
    End With
End Sub

I am trying to get it to perform this action across all worksheets in a workbook with no luck.

Here is what I have. It still seems to only do the action on the active worksheet. Any help would be greatly appreciated.

Sub UnmergeAndFill()
    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        With Selection
           If .MergeCells Then
               .MergeCells = False
               .Selection.Cells(1, 1).Copy
               .ActiveSheet.Paste 'Or PasteSpecial xlPasteFormulasAndNumberFormats
           End If
        End With
    Next ws
End Sub

Upvotes: 0

Views: 186

Answers (1)

SJR
SJR

Reputation: 23081

Can you try this? Your loop did not reference the loop variable ws, and there is no need to Select anything.

    Sub UnmergeAndFill()

    Dim ws As Worksheet, r As Range, r1 As Range

    For Each ws In ActiveWorkbook.Worksheets
        With ws.UsedRange
            If IsNull(.MergeCells) Or .MergeCells Then
              On Error Resume Next                
              For Each r In .SpecialCells(xlCellTypeBlanks)
                    If r.MergeCells Then
                        Set r1 = r.MergeArea
                        r.UnMerge
                        r1.Value = r.Value
                    End If
              Next r
             on error goto 0
            End If
        End With
    Next ws

    End Sub

Upvotes: 1

Related Questions