Macro para mesclar células em uma coluna se as mesmas linhas forem mescladas em uma coluna diferente

Question

Preciso de ajuda para encontrar uma macro que possa mesclar células nas linhas de uma coluna, se essas mesmas linhas já estiverem mescladas em outra coluna. Abaixo está uma captura de tela do que eu tenho agora que mostra as células que são mescladas na coluna A .

Acapturadetelaabaixoéoqueeuprecisoparaaaparênciadafolhadecálculoapósaexecuçãodamacro;ascélulascorrespondentesnacolunaBsãomescladas.

    

Answer 1

Este foi o menor que eu poderia fazer. Eu tentei com o seu exemplo e funcionou para mim.

Sub mergecolumn()

Dim cnt As Integer
Dim rng As Range
Dim str As String

For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
    cnt = Cells(i, 1).MergeArea.Count
    Set rng = Range(Cells(i, 2), Cells(i - cnt + 1, 2))

    For Each cl In rng
        If Not IsEmpty(cl) Then str = str + vbNewLine + cl
    Next
    If str <> "" Then str = Right(str, Len(str) - 2)

    Application.DisplayAlerts = False
    rng.Merge
    rng = str
    Application.DisplayAlerts = True

    str = ""
    i = i - cnt + 1
Next i

End Sub