دمج الخلايا الممتلئة بالصفوف الفارغة

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