الرائد77

المصنف1.xlsb

=IF(COUNTA($B$5:$B$14)=ROW($A14)-4;"مكتمل";IF(COUNTA($B$5:$B$14)=0;"فارغ";IF(COUNTA($B$5:$B$14)<ROW($A14)-4;"غير مكتمل";""))) تفضل

بحث-خلايا.xlsx

تفضل مع ان ملفك يفتقد الى البيانات
Private Sub ListBox1_Click() TEXT1.Value = ListBox1.ListIndex + 2 SpinButton1.Value = ListBox1.ListIndex End Sub Private Sub SpinButton1_Change() If SpinButton1.Value = 0 Then SpinButton1.Value = ListBox1.ListCount - ListBox1.ListCount + 1 ListBox1.ListIndex = ListBox1.ListCount - SpinButton1.Value TEXT1.Value = ListBox1.ListIndex + 2 End Sub Private Sub UserForm_Initialize() SpinButton1.Max = ListBox1.ListCount SpinButton1.Min = 0 SpinButton1.Value = 10 End Sub  
TEST.xlsm

تفضل
النبطشيه.xlsx

تفضل

BOOK--Excel.xlsm

يمكنك عمل ذللك بـ: nested if و لكن عند اضافة الشيتات تضظر دائما اللى تغييير المعادلات باضافة الاوراق  الجديدة
كما أانه في حال بيانات كثييرة تكون الاستتجابة بظيئة.
تفضل هدا  الكود اسرع و يعمل مهما اضفت من صفحات جديدة.
ضع فقط الارقام التي تريد في العمود A في ششيت البحث ثم اضغط جلب.
Sub bring() Dim ash As Worksheet Dim sh As Worksheet Dim cell As Range Dim lrw As Integer Set ash = Sheets("search") ash.Range("b2:e1000").ClearContents For Each sh In ThisWorkbook.Sheets If sh.Name <> ash.Name Then For Each cell In sh.Range("a2:a1000") lrw = ash.Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To lrw If cell = ash.Cells(i, 1) Then ash.Cells(i, 2) = cell.Offset(, 1) ash.Cells(i, 3) = cell.Offset(, 2) ash.Cells(i, 4) = cell.Offset(, 3) ash.Cells(i, 5) = cell.Offset(, 4) End If Next i Next cell End If Next sh End Sub  
جلب بيانات من الشيتات.xlsb

تم التصحيح .الكود يعمل 
الخطأ في الخلايا المدمجة.
قاعدة.xlsm

تفضل
نموذج الملف (1).xls

تتفضل. الكود يعمل 100/100 بعد التعديل. تم التجربة
Sub Button3_Click() Dim OutApp As Object Dim OutMail As Object For i = 3 To Cells(Rows.Count, 1).End(xlUp).Row Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) With OutMail .To = Range("A" & i).Value .CC = Range("B" & i).Value .Subject = Range("C" & i).Value .HTMLBody = Range("D" & i).Value .Send End With On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing MsgBox Range("A" & i).Value Next i End Sub  
إيميللات (1).xlsm

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

غير فقط  activesheet الى نطاق الصفحة الاولى
ActiveSheet.ExportAsFixedFormat xlTypePDF, mypath & "\" & Range("a11").Value & ".pdf", xlQualityStandard لتصبح
ActiveSheet.Range("A1:i33").ExportAsFixedFormat xlTypePDF, mypath & "\" & Range("a11").Value & ".pdf", xlQualityStandard  

تفضل  بالمعادلات.  و الاعمدة المساعدة
. لا تقم بايي تتغيير على المعادلات خاصة على العمود H
احصائيات حسب السن و الجنس. 
قوائم حسب السن و الجنس. لاحظ الصور

قوائم السن.xlsx

تفضل

التكت.xlsm

تفضل. اللانتقال التلقائي بمجرد الانتهاء من الرقم الرابع
أو غير هدا السطر في الملف الأول من 6 الى 4 و يعمل 100/100
If TextBox1.TextLength = 4 Then OK UserForm TextBox MaxLength.xls

=IF(D4>=3000;D4*0.2;IF(D4>=250001;D4*0.22;IF(D4>=500001;D4*0.17;"")))  
Book18.xlsx

تفضل
Private Sub CommandButton6_Click() Select Case ComboBox1.Value Case "بحث في الاسماء" ListBox1.Clear For i = 1 To 12 Controls("textbox" & i + 1).Value = "" On Error Resume Next Next i If TextBox1 = "" Then Exit Sub Sheets("Sheet1").Activate ss = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row j = 0 For Each C In Range("a2:a" & ss) If C Like TextBox1.Value & "*" Then ListBox1.AddItem ListBox1.List(j, 0) = Cells(C.Row, 1).Value ListBox1.List(j, 1) = Cells(C.Row, 2).Value ListBox1.List(j, 2) = Cells(C.Row, 3).Value j = j + 1 End If Next C Case "بحث في الرقم القومي" ListBox1.Clear For i = 1 To 12 Controls("textbox" & i + 1).Value = "" On Error Resume Next Next i If TextBox1 = "" Then Exit Sub Sheets("Sheet1").Activate ss = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row j = 0 For Each C In Range("c2:c" & ss) If C Like TextBox1.Value & "*" Then ListBox1.AddItem ListBox1.List(j, 0) = Cells(C.Row, 1).Value ListBox1.List(j, 1) = Cells(C.Row, 3).Value j = j + 1 End If Next C Case "بحث في تاريخ الميلاد" ListBox1.Clear For i = 1 To 12 Controls("textbox" & i + 1).Value = "" On Error Resume Next Next i If TextBox1 = "" Then Exit Sub Sheets("Sheet1").Activate ss = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row j = 0 For Each C In Range("b2:b" & ss) If C Like TextBox1.Value & "*" Then ListBox1.AddItem ListBox1.List(j, 0) = Cells(C.Row, 1).Value ListBox1.List(j, 1) = Cells(C.Row, 2).Value j = j + 1 End If Next C End Select End Sub 1-
2-

3-

project.xlsm

تفضل
Private Sub UserForm_Initialize() Dim rMonth As Long For rMonth = 1 To 12 Me.ComboBox1.AddItem Format(DateSerial(2020, rMonth, 1), "MMMM") Next rMonth End Sub  
monnth.xlsm

ضع هذه العلامة ( ' ) التي بين القوسين قبل النص أو الملاحظة 

تفضل

الاساسى.xlsm

تفضل

ترحيل بيانات جدول.xlsx

تفضل . طباعة الجميع بنقرة واجدة . 
انشىء مجلد باسم raed على القرص c
اختر طباعة من مثلا : 101 االى 106  . من الخلية   e1  الى   c1 .  اكتب من الرقم الذي تريد الى الرقم الذي تريد
عند انشاء الملفات و تريد اعادة انشاءها مرة ثانية . قم بمسح الملفات من المجلد raed و اعد تشغيل الماكرو 
تجد جميع الملفات pdf  في المجلد و اسم كل ملف هو كود الطالب
Sub svPDF() Dim i As Integer For i = Range("e1") To Range("c1") Range("d3").Value = i Dim expfd As String expfd = "C:\raed\" & Range("d3").Value & ".pdf" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=expfd, Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True Next i End Sub  

 

 
Student Plan.xlsm

تفضل 
  
أحمد فرج1.xls

تلوين خلايا نطاق.xlsm

بعد اذن حبيبي abouelhassan
تفضل
Private Sub CommandButton1_Click() Sheets("feuil3").Activate Sheets("feuil3").Range("c69").Select End Sub