Доработка макроса объединения ячеек

Sub ObedenitVertikal()
Dim i As Long
Dim j As Long
Dim intext As String
Application.DisplayAlerts = False
For i = 1 To Selection.Columns.Count
  intext = Selection.Cells(1, i)
  For j = 2 To Selection.Rows.Count
    intext = intext & Chr(10) & Selection.Cells(j, i)
  Next
  Selection.Columns(i).Merge
  Selection.Cells(1, i) = intext
Next
Application.DisplayAlerts = True
With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
End Sub

Sub MMM()
Application.ScreenUpdating = False
    lr = Cells(Rows.Count, 2).End(xlUp).Row + 1
    C = 2
    For i = C To lr
        If Left(Cells(i, 2).Value, 11) = "{url=https:" Then A = i
        If Cells(i, 2).Value = 0 Then
        B = i
        C = B + 1
            For j = A + 1 To B - 1
                W = W & Cells(j, 2).Value & Chr(10)
            Next
        Cells(A + 1, 2).Value = W
        W = ""
        End If
    Next
    C = lr
    For i = C To 1 Step -1
        If Cells(i, 2).Value = 0 Then B = i - 1
        If Left(Cells(i, 2).Value, 11) = "{url=https:" Then
            A = i + 2
            C = A + 3
            For j = B To A Step -1
                Rows(j).Delete
            Next
        End If
    Next
    Columns("B:B").Rows.AutoFit
Application.ScreenUpdating = True
MsgBox "Задача завершена"
End Sub