كتابة بيانات بناء على قيمة خلية

[مجاهد2013]

السلام عليكم 

في الملف المرفق شيت توزيع المطلوب كتابة الشعبة مرقمة في العمود L كما هو موضح في المرفق بحيث ترقم كالاتي : 

آداب و فلسفة 7 خلايا / لغات أجنبية إسبانية أو ألمانية 8 خلايا / باقي الشعب 9 خلايا مع الاحتفاظ بترتيب الشعب في العمود G. 

Classeur2.xlsx

[محمد هشام.]

وعليكم السلام ورحمة الله تعالى وبركاته 

جرب هدا

Option Explicit
Sub test()
    Dim ws As Worksheet: Set ws = Sheets("توزيع")
    Dim RowDest As Long: RowDest = 1
    Dim Irow As Long, tmp As Long, ky As String

    Application.ScreenUpdating = False
    ws.Range("L1:L" & ws.Rows.Count).ClearContents

    For Irow = 7 To ws.Cells(ws.Rows.Count, "G").End(xlUp).Row
        ky = ws.Cells(Irow, "G").Value
        If ky <> "" Then
            tmp = IIf(ky = "آداب و فلسفة", 7, _
            IIf(ky = "لغات أجنبية - إسبانية" Or ky = "لغات أجنبية - ألمانية", 8, 9))
            For tmp = 1 To tmp
                ws.Cells(RowDest, 12).Value = ky & tmp
                RowDest = RowDest + 1
            Next tmp
        End If
    Next Irow

    Application.ScreenUpdating = True
End Sub

 

Classeur2 v2.xlsm

[مجاهد2013]

عمل رائع شكرا أستاذ على المساعدة.