I get a diffferent answer than you got. Try this code and let me know if
changes are needed. It is not clear from your example when cells should and
should not be moved up to a higher row.

Sub combine()

RowCount = 1
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Do While RowCount <= LastRow
combineline = True
Do While (combineline = True) And _
(RowCount <= LastRow)
'test if next row is empty
combineline = False
emptycells = True
For colcount = 2 To 5
If Not IsEmpty(Cells(RowCount + 1, colcount)) Then
emptycells = False
Exit For
End If
Next colcount
If (emptycells = True) And _
(Cells(RowCount, "A") = _
Cells(RowCount + 1, "A")) Then
Rows(RowCount + 1).Delete
combineline = True
End If
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
If RowCount <= LastRow Then
If comparerow(RowCount) = True Then
For colcount = 1 To 5
If IsEmpty(Cells(RowCount, colcount)) And _
Not IsEmpty(Cells(RowCount + 1, colcount)) Then

Cells(RowCount + 1, colcount).Cut _
Destination:=Cells(RowCount, colcount)
combineline = True
End If
Next colcount
End If
End If
Loop
RowCount = RowCount + 1
Loop

End Sub
Function comparerow(ByVal RowCount As Long) As Boolean
'check if Myrow and MyRow + 1 can be combined
Match = True
Count = 0
For colcount = 1 To 5

If Len(Cells(RowCount, colcount)) 0 Then
If Len(Cells(RowCount + 1, colcount)) 0 Then
If Cells(RowCount, colcount) < _
Cells(RowCount + 1, colcount) Then

Match = False
Exit For
End If
End If
End If
If Cells(RowCount, colcount) = "" Then
'count empty cells
Count = Count + 1
End If
Next colcount
If Count = 0 Then Match = False
comparerow = Match
End Function


"ina" wrote:

Hello,

I have a problem with Excel VBA. I would like to transform figure A in
Figure B

Figure A
A B C D
1 AA ABC
2 AA AC
3 AA DD
4 AA CD
5 AA CD
6 BB BBC
7 BB CC
8 BB BBC
9 BB CD
10 BB DE


Figure B
A B C D
1 AA ABC AC DD
2 AA CD
3 AA CD
4 BB BBC BBC DE
5 BB CC CD



I tried in several ways but still I did not get the figure B result.
Could someone help me on that issue?

regards,
Ina