При удалении всех пустых строк кнопкой, а потом если добавить сразу же строку, то доб. не 1, а сразу 4 и отм объединение

Private Sub CommandButton9_Click()
ActiveSheet.Unprotect (159) 'снимается пароль
Application.Calculation = xlManual 'Отключение автоматических перерасчетов
Application.ScreenUpdating = False
Dim FirstRow As Long: FirstRow = True
With ActiveSheet
    If ActiveCell.Column > 3 And _
        ActiveCell.Row = Cells(ActiveCell.Row, "C").MergeArea(1).Row Then
    End If
    .Rows(ActiveCell.Row & ":" & ActiveCell.Row + (ActiveCell.MergeArea.Rows.Count - 1)).Copy
    .Rows(ActiveCell.Row & ":" & ActiveCell.Row + (ActiveCell.MergeArea.Rows.Count - 1)).Insert Shift:=xlDown
    If FirstRow Then
        Application.DisplayAlerts = False
            Range(Cells(ActiveCell.Row, "C"), Cells(ActiveCell.Row + _
                Cells(ActiveCell.Row + 2, "C").MergeArea.Rows.Count + 1, "C")).Merge
            Range(Cells(ActiveCell.Row, "A"), Cells(ActiveCell.Row + _
                Cells(ActiveCell.Row, "C").MergeArea.Rows.Count - 1, "B")).Merge
        Application.DisplayAlerts = True
    End If
End With
Call CommandButton35_Click
ActiveSheet.Protect Password:=159, DrawingObjects:=True, Contents:=True, Scenarios:=True, _
                    AllowFormattingColumns:=True, AllowFormattingRows:=True
Application.ScreenUpdating = True
End Sub

Private Sub CommandButton34_Click()
Dim delArea As Range
Dim RowLast As Long, i As Long, dRwF As Long, dRwL As Long
 
If MsgBox("Вы уверены что хотите удалить ВСЕ пустые строки?", vbYesNo) = vbYes Then
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect (159) 'снимается пароль
    Application.Calculation = xlManual 'Отключение автоматических перерасчетов
    
    With ActiveWorkbook.ActiveSheet
        RowLast = .Cells.Find(What:="*", After:=Cells(1, 1), SearchOrder:=xlByRows, _
                                SearchDirection:=xlPrevious).Row
        For i = RowLast To 8 Step -1
            If .Cells(i, "C").MergeArea.Rows.Count > 1 Then
                dRwF = .Cells(i, "C").MergeArea(1).Row
                dRwL = i
                If .Cells(i, "C").MergeArea(1) = "" Then
                    If delArea Is Nothing Then
                        Set delArea = Range(dRwF & ":" & dRwL)
                    Else
                        Set delArea = Union(delArea, .Range(dRwF & ":" & dRwL))
                    End If
                End If
                i = dRwF
            End If
        Next
        If Not delArea Is Nothing Then delArea.Delete
    End With
    Call CommandButton35_Click
    ActiveSheet.Protect Password:=159, DrawingObjects:=True, Contents:=True, Scenarios:=True, _
    AllowFormattingColumns:=True, AllowFormattingRows:=True
    Application.ScreenUpdating = True
End If
End Sub