Excel VBA - Row with merged cells, code for unmerging and Concatenating data

Question

Hi - I have been stuck on some VBA - I have extracted some data which is displayed in columns - the problem is some of the data in column 3 has been put into 2 cells - meaning all the corresponding cells in those 2 rows have been merged. A way round this which I have done using VBA is to split any merged cells within the same row and duplicate their contents in the new unmerged cells - this essentially has created a lot of duplicate data - so dont really want to do this

I am not sure if anyone has got any ideas on the best solution for this. All i really want to do is concatenate Column 3A data with column 3B data -so putting them in the same cell and removing the merged cells- but this can be dynamic and not every row in this column may be split like this See below:

I have used this code: this only removes the merged cells and duplicates the data in the new empty cells from their corresponding cells.

 Dim rng As Range, xCell As Range Set WorkRng = recwbk.Worksheets(1).Range("A3:M" & recwbk.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row) 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

But what i am trying to achieve is the below

Answer 1

Sub Tester22()

    Dim col As New Collection, maxRows As Long, n As Long
    Dim c As Range, c2 As range
    
    'loop over row2 and check for merged cells
    For Each c In ActiveSheet.Range("B2:G2").Cells
        n = c.MergeArea.Rows.Count
        If n > 1 Then
            If n > maxRows Then maxRows = n 'tracking max # rows merged
            c.UnMerge
        Else
            col.Add c 'not merged: deal with these later
        End If
    Next c
    
    'loop over the unmerged cells and pull content from the rows below
    For Each c In col
        For n = 2 To maxRows
            Set c2 = c.Offset(n - 1, 0)
            c.Value = c.Value & vbLf & c2.Value
            c2.ClearContents
        Next n
    Next c
End Sub