محمد هشام.

حل اخر ادا لم يكن عندك مانع في طريقة ترتيب التوزيع Sub Dis_numbers() Dim rng As Range Dim rng2 As Range Dim cell As Range 'الخلايا المستهدفة Set rng = Range("I3,F3,C3,N12") For Each cell In rng Set rng2 = Range(cell.Offset(1, -1), cell.Offset(4, -1)) rng2.Value = Int(cell.Value / 5) cell.Offset(0, -1).Value = cell.Value - Application.WorksheetFunction.Sum(rng2) Next cell End Sub ''''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''حدث ورقة 1''''''''''''''''''' Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'Row Number If Target.Row = 3 Then Exit Sub Select Case Target.Column 'Columns Case 3, 6, 9 Call Dis_numbers End Select ' Cell N12 'Column ("N") If Target.Row = 12 Then Exit Sub Select Case Target.Column Case 14 Call Dis_numbers End Select End Sub توزيع رقم 3.xlsb

Sub Sheets_Arrays1() Dim temp As Variant Dim arr As Variant Dim F As Boolean Dim ws As Variant Dim WSdata As Worksheet: Set WSdata = Sheets("Total") For Each ws In Sheets(Array("1", "2", "3")) temp = ws.Range("k5:N" & ws.Cells(Rows.Count, 11).End(xlUp).Row).Value If F Then arr = ArrayJoin(arr, temp) Else arr = temp F = True End If Next ws With Sheets("Total") .Range("C4").Resize(1, 4).Value = Array("م", "الاسم", "الرقم الوظيفي", "سعد") .Range("C5").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr End With End Sub '''''''''''''''''''ترحيل البيانات في اخر صف فارغ''''''''''''''''''''''' Sub Sheets_Arrays2() Dim F&, j& Dim ws As Variant Dim WSdata As Worksheet: Set WSdata = Sheets("Total") WSdata.Range("C4").Resize(1, 4).Value = Array("م", "الاسم", "الرقم الوظيفي", "سعد") For Each ws In Sheets(Array("1", "2", "3")) F = ws.Cells(Rows.Count, "K").End(xlUp).Row j = WSdata.Cells(Rows.Count, "C").End(xlUp).Row Application.ScreenUpdating = False ws.Range("K5:N" & F).Copy Destination:=WSdata.Range("C" & j + 1) Application.ScreenUpdating = True Next ws End Sub ترحيل من عدة صفحات V3.xlsm

ممكن توضيح ما هي طريقة البحث المطلوبة

https://streamable.com/md5m4x

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

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

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

ناجح v2.xlsx

تقصد بشرط عدد السنوات ..يمكنك تغيير المعادلة بهدا الشكل =INDEX($I$3:$M$6; MATCH(C2;$H$3:$H$6;0); MATCH(B2; $I$2:$M$2; 0)) ملف v3.xlsx

=IF($D$6="";"";IF($D$6="غ";"غ";IF($D$6>=50;"ناجح";IF($D$6<50;"له برنامج علاجي";"")))) ناجح v2.xlsx

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

تفضل اخي سعد حاولت قدر الامكان تنفيد المطلوب لاكن بطريقة مختلفة اتمنى ان تستفيد منها مع بعض الاظافات البسيطة في انتظار الرد بعد التجربة sella v4.xlsm

وعليكم السلام ورحمة الله تعالى وبركاته ادا كنت قد فهمت طلبك بشكل صحيح =INDEX($I$3:$I$6;MATCH(C2;$H$3:$H$6);1) v2 ملف.xlsx

تمام ابشر اخي سعد ساحاول تنفيد المطلوب ان شاء الله

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

تفضل اخي بالتوفيق..... دوائر v3.xls

تفضل اخي Option Explicit Sub selectasheet() If Not SheetExists("" & Sheets("basic").Range("b2").Value) Then MsgBox "ورقة العمل غير موجودة!" Else Sheets("" & Sheets("basic").Range("b2").Value).Select End If End Sub Function SheetExists(SheetName As String) As Boolean SheetExists = False On Error GoTo NoSuchSheet If Len(Sheets(SheetName).Name) > 0 Then SheetExists = True Exit Function End If NoSuchSheet: End Function المساعدة.xlsm

تفضل اخي Function circle1(dr As Range) Dim OvName As String OvName = "oval" + dr.AddressLocal MrH = 0.3 * dr.Height MrW = 0.2 * dr.Width OvalW = dr.Width - MrW OvalH = dr.Height - MrH Set shShape = dr.Worksheet.Shapes.AddShape(msoShapeOval, dr.Left + MrW / 2, dr.Top + MrH / 2, OvalW, OvalH) With shShape .Name = OvName .Fill.Visible = msoTrue .Line.Weight = False .Fill.ForeColor.RGB = RGB(255, 255, 0) End With End Function دوائر v2.xls

تفضل جرب دوائر.xls

اخي هده مسالة اخرى ليس لها علاقة بالقوائم ولم نشتغل عليها من قبل على العموم تفضل اخي Dynamic Orders - Pivot_V11.xlsm

اخي اولا هل النطاق المرحل ثابث يعني 15 صف ثانيا هل تقصد عند كل ترحيل ان تكون البيانات المرحلة دائما في مابين راس الصفحة وزيلها ثالثا هل الاوراق ستكون تحت بعضها

اخي المفروض وضع الملفات بدون حماية محرر الاكواد او على الاقل ارفاق الباسوورد داخل المشاركة تفاديا لاهدار الوقت على العمود تم كسرها واتمام المطلوب تفضل جرب Dynamic Orders - Pivot_V10.xlsm Dynamic Orders - Pivot_V10.xlsm

=MID(SUBSTITUTE(A$1;" ";"");ROWS(A$2:A2);1)

تفضل اخي In French =SI((LIGNE()-1)<=NBCAR(SUBSTITUE(A$1;" ";""));STXT(SUBSTITUE(A$1;" ";"");LIGNE()-1;1);"") In English =IF((ROW()-1)<=LEN(SUBSTITUTE(A$1;" ";""));MID(SUBSTITUTE(A$1;" ";"");ROW()-1;1);"") فرز.xlsx

مجرد سؤال لمادا تصر على الاشتغال بتعبئة القوائم بالاكواد رغم انها تعطيك رسائل خطا......هناك طرق افضل واسهل يمكنك مثلا انشاء قاعدة بيانات بالاسماء التي تشتغل عليها وربطها بقوائم دينامكية بدون اكواد