ابو مارفن

عاشت ايدك ومشكور استاذي العزيز على جهودك الله يحفظك ويرحم امواتك ويجعلها بميزان حسناتك تحياتي لحضرتك

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

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

عاشت ايدك استاذي العزيز الله يحفظك ويبارك بجهودك مشكوووور تحياتي لحظرتك الله يجعلها بميزان حسناتك

السلام عليكم استاذ محمد اسف ان لم اوصل لك المطلوب بشكل دقيق فانا احتاج ان تظهر كل الخلايا العمود ومنها الخلايا الفارغة وخلايا التي تحتوي على فراغ وخلايا الارقام لمسح الصف المختار اذا كان الاختيار خليه الرقم فيمسح صف الخليه المختاره وعند اختيار خليه فارغة فيمسح صف الخليه الفارغة وعند اختيار خليه تحتوي على فراغ فيمسح صف الخليه التي تحتوي على فراغ تحياتي لحظرتك وشكرا لجهودك

TEST 1.rar

غدا سارفع ملف توضيح للمطلوب قبل التنفيذ والنتيجة تقبل تحياتي

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

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

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

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

عاشت اناملك استاذنا العزيز الله يجعلها بميزان حسناتك تحياتي لحظرتك

عاشت ايدك استاذنا العزيز هل يمكن ان يظهر الكود في حال وجود خلية فارغة ليتم اختيارها ومسح الصفوف الفارغة كما في الملف المرفق Private Sub UserForm_Initialize() Dim r As Long, r1 As Long, r2 As Long r2 = Range("xfd10000").End(xlUp).Row Range("XFD1:XFD" & r2).ClearContents r = Range("B10000").End(xlUp).Row Range("B2:B" & r).Copy Range("xfd1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False ActiveSheet.Range("$xfd$1:$xfd$" & r).RemoveDuplicates Columns:=1, Header:=xlNo r1 = Range("xfd10000").End(xlUp).Row Me.ComboBox1.RowSource = ("xfd1:xfd" & r1) Me.ComboBox1.Value = Range("xfd1").Value End Sub .الله يحفظك ويبارك بجهزدك ويجعلها بميزان حسناتك تحياتي لك تعديل صفوف الكلمات المختاره او صفوف الخلايا الفارغة عند اختيارها.xlsm

مشكور على ردك استاذ انا اقصد ان يتم العمل على ملف الكليه دون اضافة الكود في الملف اي ان يتم التنفيذ الكود من كود الملف الاصلي ( يعني في حال عندي ملفات اخرى اقوم فقط بتغيير اسم الملف في كود الملف الاصلي واسم الشيت ليتم تنفيذه على الملف المطلوب)ويكون الملفان مفتوحان بنفس الوقت تحياتي لك

Public Property Get CrWS() As Worksheet Set CrWS = Sheets("ورقة1") End Property Private Sub UserForm_Initialize() Dim Tbl As Object, c As Range, temp As Variant, lastRow As Long Set Tbl = CreateObject("Scripting.Dictionary") lastRow = CrWS.Cells(CrWS.Rows.Count, "B").End(xlUp).Row If lastRow > 1 Then For Each c In CrWS.Range("B2:B" & lastRow) If c.Value <> "" Then Tbl.Item(c.Value) = c.Value Next c End If If Tbl.Count > 0 Then temp = Tbl.items Me.ComboBox1.List = temp End If End Sub Private Sub CommandButton1_Click() Dim lastRow As Long, ky As String If Me.ComboBox1.Value <> "" Then ky = "=*" & Me.ComboBox1.Value & "*" lastRow = CrWS.Cells(CrWS.Rows.Count, "B").End(xlUp).Row If lastRow < 2 Then Exit Sub Application.ScreenUpdating = False With CrWS.Range("B1:B" & lastRow) .AutoFilter Field:=1, Criteria1:=ky End With On Error Resume Next CrWS.Range("A2:C" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete On Error GoTo 0 CrWS.AutoFilterMode = False Application.ScreenUpdating = True Unload Me End If End Sub السلام عليكم ممكن تعديل على الكود ليعمل على ملف اخر مفتوح وليكن اسمه كلية واسم الشيت القسم مع جزيل الشكر كلية.xlsb ملف الاصلي.xlsb