Объединение строк по повторяющимся значениям

Sub RangeMergeSub()
    Dim i%, j%, lRow%
    Dim lLastRow&
    lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    lRow = 0
    For i = 1 To lLastRow
        If Range("A" & i).MergeCells = False Then
            For j = i + 1 To lLastRow
                If Range("A" & i).Value = Range("A" & j).Value Then
                    lRow = j
                End If
            Next j
            If lRow > 0 Then
                Application.DisplayAlerts = False 'отключаем предупреждения. Иначе перед каждым объединением будем получать сообщение о возможной потере данных при слиянии
                Range("A" & i & ":A" & lRow).Merge
                Application.DisplayAlerts = True
            End If
            lRow = 0
        End If
    Next i
    MsgBox "done"
End Sub

lLastRow = Cells(Rows.Count, 1).End(xlUp).Row

Sub УдалДвойнСтроки()
Set CurrentCell = ActiveCell
Do While Not IsEmpty(CurrentCell)
Set nextCell = CurrentCell.Offset(1, 0)
If nextCell.Value = CurrentCell.Value Then
'CurrentCell.Delete Shift:=xlUp 'Включать если надо удалять только ячейку
CurrentCell.EntireRow.Delete 'Включать если надо удалять всю строку
End If
Set CurrentCell = nextCell
Loop
End Sub

 lLastRow = Cells(Rows.Count, 1).End(xlUp).Row

 lLastRow = Cells(Rows.Count, 5).End(xlUp).Row

Range("A" & i & ":A" & lRow).Merge

Sub RangeMergeSub()
    Dim i%, j%, lRow% 'объявляем переменные integer
    Dim lLastRow& 'объявляем переменные long
    lLastRow = Cells(Rows.Count, 1).End(xlUp).Row 'определяем последнюю непустую строку
    lRow = 0 'сбрасываем счетчик одинаковых ячеек
    For i = 1 To lLastRow 'основной цикл, проверяет все ячейки
        If Range("A" & i).MergeCells = False Then 'если ячейка не имеет слияния, значит она не обработана
            For j = i + 1 To lLastRow 'вложенный цикл ищет одинаковые значения с проверяемой ячейкой
                If Range("A" & i).Value = Range("A" & j).Value Then 'если ячейки одинаковы
                    lRow = j 'запоминаем крайний номер ячейки до которой нужно слить
                End If
            Next j
            If lRow > 0 Then 'если такие ячейки были найдены
                Application.DisplayAlerts = False 'отключаем предупреждения. Иначе перед каждым объединением будем получать сообщение о возможной потере данных при слиянии
                Range("A" & i & ":A" & lRow).Merge 'сливаем их
                Application.DisplayAlerts = True
            End If
            lRow = 0 'сбрасываем счетчик
        End If
    Next i
    MsgBox "done"
End Sub