Unmerge and copy down across multiple sheets

Question

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

It's most likely because you're using `Select`. See [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) — dwirony, Oct 09 '17 at 16:02

SJR · Answer 1 · 2017-10-10T18:55:18.147

1

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

edited Oct 10 '17 at 18:55

answered Oct 09 '17 at 16:02

SJR

22,986
6
18
26

This does not seem to do anything. But it could be the guy running it :) – Mindbender Oct 09 '17 at 17:26
It unmerges cells, when I do it at least. Does that not happen for you? – SJR Oct 09 '17 at 17:46
Unfortunately no. It appears to run and does not throw any errors but each worksheet in the workbook appears untouched – Mindbender Oct 09 '17 at 18:09
Can you merge some cells on a sheet manually and then run it and see what happens. – SJR Oct 09 '17 at 18:14
I created a new tab and merged a few cells and ran it and it did not error out or throw any errors but it did not unmerge the cells. The worksheet remained as it was before it was run – Mindbender Oct 09 '17 at 18:19
Strange. Do you have any other workbooks open? If not, can you try replacing `UsedRange` with `Cells`. – SJR Oct 09 '17 at 18:39
Still nothing. I did run the following and it worked but only on the active sheet. Can't seem to get it to work on all sheets in the workbook – Mindbender Oct 09 '17 at 18:46
Sub UnmergeAndFill() Dim cell As Range, joinedCells As Range For Each cell In ThisWorkbook.ActiveSheet.UsedRange If cell.MergeCells Then Set joinedCells = cell.MergeArea cell.MergeCells = False joinedCells.Value = cell.Value End If Next End Sub – Mindbender Oct 09 '17 at 18:47
Please don't post code in comments - it's unreadable. I've amended the code above - can you try it now? – SJR Oct 09 '17 at 18:59
Sorry about that. The revised code does unmerge all of the cells in the workbook. But it does not copy the values to the newly empty cells – Mindbender Oct 10 '17 at 15:47
Ah I missed that bit. What should go where? – SJR Oct 10 '17 at 18:03
basically whatever was in the merged cells should go into all the cells that were unmerged – Mindbender Oct 10 '17 at 18:04
Amended again above, was more involved than I thought. Ended up using special cells as merged cells show up as blanks. – SJR Oct 10 '17 at 18:57
Glad we got there in the end. Perhaps you could accept the answer? – SJR Oct 10 '17 at 19:13
How do I do that? :) – Mindbender Oct 10 '17 at 19:25

Unmerge and copy down across multiple sheets

1 Answers1