اشكرك على تعبك معي ولكن مازال الكود لايضم 3 صفوف وهذا هو الكود بعد التعديل :
( )Sub Test
Dim m As Long, r As Long, n As Long
Application.ScreenUpdating = False
With ActiveSheet
m = .Cells(Rows.Count, 1).End(xlUp).Row
n = 1
.Columns("K:M").WrapText = True
For r = 1 To m Step 3
.Range("K" & n).Resize(, 3).Value = Array(.Range("A" & r).Value & vbLf & .Range("A" & r + 1).Value, .Range("B" & r).Value & vbLf & .Range("B" & r + 1).Value, .Range("C" & r).Value & vbLf & .Range("C" & r + 1).Value)
.Range("K" & n).Resize(, 3).Value = Array(.Range("A" & r).Value & vbLf & .Range("A" & r + 1).Value, .Range("B" & r).Value & vbLf & .Range("B" & r + 1).Value, .Range("C" & r).Value & vbLf & .Range("C" & r + 1).Value)
n = n + 1
Next r
End With
Application.ScreenUpdating = True
End Sub
دمج3 صفوف.xlsm