Макросом сцепить значения из ячеек и удалить пустые строки

Sub DeleteEmptyRows()
    Dim LastRow As Long
    Dim r As Long
    LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
    Application.ScreenUpdating = False
    For r = LastRow To 1 Step -1
        If Application.WorksheetFunction.CountA(Rows(r)) = 0 _
          Then Rows(r).Delete
    Next r
End Sub

Sub Обработчик_строк()
Sheets("1").Select
For i = 9 To 100
s = "A" + Str(i)
ss = "V" + Str(i)
Range("A9").Select
j = i + 1
If ActiveCell.FormulaR1C1 <> "" Then
While (Cells(j, "A").FormulaR1C1 = "") And (j < 100)
Cells(i, "V").FormulaR1C1 = Cells(i, "v").FormulaR1C1 + " " + Cells(j, "V").FormulaR1C1
Cells(j, "V").FormulaR1C1 = ""
j = j + 1
Wend
End If
Next
For i = 1 To 100
s = "A" + Str(i)
Cells(i, "A").Select
While ActiveCell.FormulaR1C1 = ""
Selection.EntireRow.Delete
Wend
Next
End Sub

Sub KonkStr()
Dim I As Long, LL As Long, LRows As Long, SS As Long
Dim J As Integer, K As Long, sss As String, Ip As Integer
Sheets("1").Select
Range("A9").Select 'нач.яч.просмотра 
LRows = ActiveSheet.Rows.Count
Application.ScreenUpdating = False
J = 5 'заменить на свой номер колонки, в которой объединяются ячейки
SS = 9 'номер нач.строки для просмотра (можно запросить в диалоге)
Do
    LL = Selection.End(xlDown).Row
    If LL = LRows Then
        Cells(SS, J).Select
        LL = Selection.End(xlDown).Row + 1
        If LL = LRows + 1 Then Exit Do
        Ip = 1
    End If
    K = LL - SS - 1
    If K > 0 And Cells(LL - 1, 1) = "" Then
        sss = Cells(SS, J).Value
        For I = SS + 1 To LL - 1
            sss = sss & Cells(I, J).Value
        Next I
        Cells(SS, J).Value = sss
        For I = LL - 1 To SS + 1 Step -1
            Rows(I).Delete
        Next I
    End If
    If Ip = 1 Then Exit Do
    SS = SS + 1
    Cells(SS, 1).Select
Loop
Application.ScreenUpdating = True
End Sub