عادل حنفي

اخي بداية انا نزلت الملف ويعمل عندي بكفاءه
يوجد حلين
الاول سارسل لك ملف باسم
Mdule
فك ضغطه في اي مكان ومن visual Basic editor
,وتحت قائمه vba project
كليك يمين و اختر import file و اختر الملف الذي حفظته سابقا
الحل الاخر قديكون في اعدادات الاكسل
سارسل لك ملفين
الاول 10
هذا اذا كان اصار الاكسل عندك version 10
الثاني 11
هذا اذا كان اصار الاكسل عندك version 11
و اعلمتي بالنتيحه
Module.rar
Excel_10.rar
Excel_11.rar

السلام عليكم
اخي العزيز tofimoon4
ما هو الذي يقف امامك
اخي كل ما عليك هو الاتي
انشاء صفحة و سمها باسم ترتيب القوائم
و في محرر كودها الصق هذا الكود

Private Sub Worksheet_Activate()   If Range("B1") = "0" Then   Exit Sub   Else   On Error Resume Next     Range("A2:A10000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete     ActiveSheet.UsedRange     End If Dim x As Long     Dim LastRow As Long     LastRow = Range("A400").End(xlUp).Row     For x = LastRow To 1 Step -1         If Application.WorksheetFunction.CountIf(Range("A2:A" & x), Range("A" & x).Text) > 1 Then             Range("A" & x).EntireRow.Delete         End If     Next x     Range("A3:A10000").Sort Key1:=Range("A3"), Order1:=xlAscending, Header:= _         xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _         DataOption1:=xlSortNormal End Sub
و الخليه B1 بهذه الصفحة بها معادله انسخها ايضا و الصقها في الخليه B1
جرب و قولي ما يحدث و نحن معك الي ان يتم ما تريد
و اعتقد ان يكون هذا سبب المشكله في اول مره يعمل بها الكود في ملف
جديد فقط قم بكتابة 1 في الخليه A3
وبعد ذلك سيكون العمل بشكل عادي فلسبب ما اجهله الان قمت بكتابة شرط
ان الخليه B1 اذا كانت تساوي صفرا لا يعمل الكود و اكيد انا عملت ده لسبب
ما لا اتذكره الان و حتي لا اكون متسرعا و اقولك الغي هذا الشرط
قم بعمل ما قلته لك و ان شاء الله يعمل الملف معاك
تحياتي

السلام عليكم
اخي تم عمل كود ليتم اضافة ما هو اكبر من الواحد او يساوي الواحد الي خانة الجنيه
و انزال الكسر الي خانة القروش و تم اضافة كود التفقيط و لكن لا اعرف ان كان
العمل هكذا تم بالنسبة اليك ام يوجد جزء لم يكتمل
ارجو التجربة واخبار بالنتيجة
تحياتي
_______50.rar

السلام عليكم
اخي العزيز tofimoon4
اتمني ان يكون هذا هو طلبك
ارجو التجربة و اخباري بالنتيجة
تحياتي

tofimoon_last.rar

السلام عليكم
الله يسامحك اخي
تفضل اخي و ارجو ان يكون المطلوب
_______.rar

اخي ابو سليمان
جرب المرفق وان شاء الله يكون المطلوب
تحياتي
افسينا .rar

اخي
جرب المرفق
1.xlsm

اخي الان يمكنك البحث عن اللرقم  الذي تريده من بداية  الرقم الاول من علي اليسار
او اول رقمان علي اليسار وهكذا حتي اول تمانية ارقام علي اليسار
والكود هو
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = Range("C3").Address Then If Target <> "" Then Range("C5:D1000").ClearContents s = Len(Range("C3")) If s > 0 Then x = 2 For i = 2 To 1000 If Sheets("Data").Cells(i, x) <> "" Then m = Sheets("Data").Cells(i, x).Address o = Left(Sheets("Data").Range(m), 1) oo = Left(Sheets("Data").Range(m), 2) ooo = Left(Sheets("Data").Range(m), 3) oooo = Left(Sheets("Data").Range(m), 4) ooooo = Left(Sheets("Data").Range(m), 5) oooooo = Left(Sheets("Data").Range(m), 6) ooooooo = Left(Sheets("Data").Range(m), 7) oooooooo = Left(Sheets("Data").Range(m), 8) If Range("C3").Text = o Or Range("C3").Text = oo Or Range("C3").Text = ooo Or Range("C3").Text = oooo Or Range("C3").Text = ooooo Or Range("C3").Text = oooooo Or Range("C3").Text = oooooo Or Range("C3").Text = ooooooo Or Range("C3").Text = oooooooo Then With Columns(4).Rows(2000).End(xlUp) .Offset(1, 0) = Sheets("Data").Cells(i, x) Cells(.Offset(1, 0).Row, 3) = Sheets("Data").Cells(i, x - 1) End With End If End If Next End If End If End If End Sub اما بخصوص المدي فيحدد عاموده ال X في سطر الذي هو x = 2
اما الذ يجدد الصف هذا السطر الخاص بالحلقة الدائرية For i = 2 To 1000
فيبدأ في البحث عن الرقم المطلوب في الصف 2 ثم 3 ونهاية بــ 1000
ارجو ان كون استطعت ايصال المعلومة
تحياتي
ارقام 2 (2).xlsm

جرب المرفق
ولاحظ ان نتيجة الاستيراد ستكون بين التاريخان المسجلان
وقد قمت ببعض التعديلات غلي شيت بيان العملاء تحسبا لوجود عميل له دفعات مقدمة
Copy of وارد شهري الجارحي1.xlsm

اخي
جرفب المرفق غير فقط في الخلية B1
COPY-VBA.xlsm
عذرا اخي وجيه
فلقد كنت اعمل علي الملف ولمجرد رفعه شاهدت مشاركتك فارجو المعذرة
 

اخي ضع في الخلية B2 بداية الارقام وفي الخليةة B3 ضع الرقم الذي ستنتهي عنده الارقام
ثم اضغط  علي زر توزيع
ارجو ان يكون المطلوب
مصفوفة.xlsm

الان فهمت ماتريده تقريبا وقد تذكرت دالة كان عاملها القدير ابو تامر اسمها VLOOK2ALL
ولكن يشترط نقل العامود الذي تضع فيه 1 للعد قبل عامود رقم الجلوس
والدالة مرقفة في الملف في مديول
جرب كده اعتقد انها ستحل المشكلة
دليل التظريف.xlsm

اخي
   جرب المرفق
Copy of combobox.xlsm

السلام عليكم
ارجو تجربة المرفق وقد تم مراعاة معظم المشاكل
لكن عليكي بان يكون القسم المدرج تحته البيانات مطابقا للعمل للتوضيح يجب ان
يكون العمل مادة القرآن الكريم وليس القران تحت قسم مادة القرآن الكريم
وقد تم عمل الملف بطريقة يسهل تعاملك معه بالرغم  من انه استغرق 3 ايام لفكرة صغيرة وهي كيفية التعرف علي الاقسام والصف الاخير في كل قسم
اخيرا بنفس طريقة عملك لهذا الملف صممي الملف الذي سيتم عليه عملك الفعلي والصقي نسحة فارغة من البيانات وليس من  الاقسام في شيت Source
فهو الشيت الذي يعتمد عليه لعمل نسخة لكل مدرسة
ارجو انني قد فهمت المطلوب ونفذ بالطريقة الصحيحة ولو فيه اي استفسار انا منتظر للرد عليه
تحياتي
حافظة الدوام أوفيسنا.rar

اخي جرب المرفق
 
ComboBox.xlsm