Sub Alsar_Merge()
'اعداد/ اسلام عبدالله
Dim a, b, c&
If ActiveCell.Value = "" Then MsgBox "يجب تحديد خلية بها نص أولاً", vbInformation + vbMsgBoxRight, "أكاديمية الصقر للتدريب": Exit Sub
a = ActiveCell.Row
b = ActiveCell.End(xlDown).Row - 1
c = ActiveCell.Column
If Cells(b, c) & Cells(b + 1, c) = "" Then MsgBox "باقى العمود فارغ", vbInformation + vbMsgBoxRight, "أكاديمية الصقر للتدريب": Exit Sub
Do
Range(Cells(a, c), Cells(b, c)).Merge
a = b + 1: b = Cells(a, c).End(xlDown).Row - 1
If Cells(b + 1, c).Value = "" Or Cells(a, c).Row = Rows.Count Then MsgBox "تم دمج الخلايا", vbInformation + vbMsgBoxRight, "أكاديمية الصقر للتدريب": Exit Sub
Loop
End Sub