Const START_ROW = 1
Const END_ROW = 3000
Const COL_TARGET = 1
Const COL_SOURCE = 2
Const TARGET_SHEET = "Sheet1"
Public Sub MERGEROWS()
Dim s As Worksheet
Set s = ThisWorkbook.Sheets(TARGET_SHEET)
Dim i As Integer
Dim result As String
Dim resultRow As Integer
resultRow = 1
result = Trim(s.Cells(1, COL_TARGET).Text)
For i = START_ROW To END_ROW Step 1
Dim name As String
name = Trim(s.Cells(i, COL_SOURCE).Text)
If name = "" Then
result = result + Trim(s.Cells(i, COL_TARGET).Value)
s.Cells(i, COL_TARGET).Value = ""
Else
s.Cells(resultRow, COL_TARGET).Value = result
result = Trim(s.Cells(i, COL_TARGET).Value)
resultRow = i
End If
Next
End Sub