اضافة سجل جديد أسفل المهنة المماثلة له

[وليد عفيفي]

ارجو المساعدة فى الملف المرفق اريد عند اضافة محاسب يتم اضافة اسفل مهنة محاسب وبالمثل كل مهنة اسفل المهنة التى مثلها

 

الملف المرفق : 

WALID.rar

[سليم حاصبيا]

جرب هذا الكود

الكود لا ينفذ العمل الا اذا امتلأ اخر صف في الجدول

Private Sub Worksheet_Change(ByVal Target As Range)
lr = Cells(Rows.Count, 2).End(3).Row
If Target.Row = lr Then

 If Application.WorksheetFunction.CountA(Range(Cells(lr, 1), Cells(lr, 8))) = 8 Then
 Range("A10:H" & lr).Select
    ActiveWorkbook.Worksheets("مثال1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("مثال1").Sort.SortFields.Add Key:=Range("E11:E" & lr) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "محاسب,شئون عاملين,مهندس ميكانيكا,مهندس كهرباء,سائق,فني تشغيل", DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("مثال1").Sort
        .SetRange Range("A10:H" & lr)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
        End If
        End If
 
End Sub

 

 

تم تعديل مارس 4, 2016 بواسطه سليم حاصبيا

[وليد عفيفي]

السلام عيكم استاذ / سليم

شكرا على ردكم الغالى وجعله الله في ميزان حسناتكم

ارجو منك تطبيق هذا الكود الرائع على الملف المرفق حيث انني حاولت ولكن لم استطيع الوصول الى كيفية تطبيقة على الملف 

وجزاكم الله خير 

 

الملف المرفق :   WALID.rar

[سليم حاصبيا]

تفضل اخي

الملف جاهز مع الكود  ( الكود لا ينفذ العمل الا اذا امتلأ اخر صف في الجدول )

WALID salim1.rar

تم تعديل مارس 7, 2016 بواسطه سليم حاصبيا

[وليد عفيفي]

السلام عليكم استاذ / سليم

شكرا جزيلا على اهتمامكم بالرد والافادة وارجو من الله ان يتقبل منكم هذا العمل ويجعله فى ميزان حسناتكم وان يزيدكم علما وجزاكم الله خيراً

 

[وليد عفيفي]

السلام عليكم ا / سليم

قابلتنى مشكلة وهى فى حالة عمل معادلة فى خلية لا يعمل الكود

وايضا فى حالة وجود خلية فارغة ايضا

فرجو منكم الحل

[سليم حاصبيا]

جرب الملف المرفق

 

WALID salim.rar