حسونة حسين

وجزاكم مثله اخى الكريم الحمد لله الذي بنعمته تتم الصالحات

خطوة ١ ازاله الفلتر من الخليه N6 خطوة عمل تحديد لجميع خلايا الشيت مثل مكان الماوس في هذه الصورة ثم كليك يمين واختيار row height ثم كتابه الرقم وليكن ٢٣ وهو ارتفاع الصف عندك في الصفوف السابقه

السلام عليكم ورحمة الله وبركاته تفضل اخى الكريم Book5-1.xlsx

الحمد لله الذي بنعمته تتم الصالحات

تفضل اخى الكريم لعله ما تريد ترويسةالعوري.docx

الحمد لله الذي بنعمته تتم الصالحات بالتوفيق ان شاء الله

هذه المتغيرات كانت في كودك ليس لها بالنسبه لي استخدام في الكود بهذا الشكل

تفضل اخى الكريم Dim strDate As String, strTime As String Dim filePath As String Dim ws As Worksheet Dim i As Long Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual For i = 0 To ListBox1.ListCount - 1 If ListBox1.Selected(i) = True Then For Each ws In ThisWorkbook.Worksheets For Each f In ws.Range("a2:a" & cells(Rows.Count, "A").End(xlUp).Row) If f = ListBox1.List(i, 0) Then f.Offset(0, 3).Value = "ايقاف" f.Offset(0, 4).Value = Date Exit For End If Next f Next ws End If Next i i = Empty Application.Calculation= xlCalculationAutomatic Application.EnableEvents = True Application.DisplayAlerts = True Application.ScreenUpdating = True

اخى نزل الملف مره اخرى تم تعديله او انسخ الكود مره اخرى Sub Test() Dim SH As Worksheet, WS As Worksheet, SHLR As Long, WSLR As Long, CEL As Range Application.DisplayAlerts = False Application.EnableEvents = False Set WS = ThisWorkbook.Worksheets("Total") For Each SH In Worksheets If SH.Name <> "Total" Then With SH SHLR = SH.Cells(Rows.Count, 4).End(xlUp).Row + 1 For Each CEL In SH.Range("D14:D" & SHLR) If CEL.Value <> Empty Then WSLR = WS.Cells(WS.Rows.Count, 1).End(xlUp).Row + 1 WS.Range("A" & WSLR) = SH.Range("I14") WS.Range("B" & WSLR) = SH.Range("L14") WS.Range("C" & WSLR) = CEL.Value End If Next CEL End With End If Next SH Application.DisplayAlerts = True Application.EnableEvents = True End Sub

وعليكم السلام ورحمة الله وبركاته تفضل اخى الكريم ان شاء الله يكون طلبك ضع هذا الكود في ملفك في userform1 بدل الأكواد الموجوده Private Sub CommandButton1_Click() For x = 2 To Cells(Rows.Count, "A").End(xlUp).Row If Cells(x, 1) = TextBox1.Text Then Cells(x, 4) = TextBox4.Text Cells(x, 5) = TextBox5.Text Cells(x, 6) = TextBox6.Text Cells(x, 7) = TextBox7.Text Cells(x, 8) = TextBox8.Text Cells(x, 9) = TextBox9.Text Cells(x, 10) = TextBox10.Text Cells(x, 11) = TextBox11.Text Cells(x, 12) = TextBox12.Text Cells(x, 13) = TextBox13.Text Cells(x, 14) = TextBox14.Text Cells(x, 15) = TextBox15.Text Cells(x, 16) = TextBox16.Text Cells(x, 17) = TextBox17.Text Cells(x, 18) = TextBox18.Text Exit For End If Next x End Sub Private Sub CommandButton2_Click() UserForm1.Hide UserForm2.Show End Sub Private Sub CommandButton3_Click() sheet1.Activate UserForm1.Hide End Sub Private Sub CommandButton4_Click() UserForm1.Hide sheet3.Activate UserForm4.Show End Sub Private Sub TextBox1_Change() Dim x For x = 3 To Cells(Rows.Count, "A").End(xlUp).Row If TextBox1.Text = Cells(x, 1) And TextBox1.Value <> "" Then TextBox2.Value = Cells(x, "b").Value TextBox4.Value = Cells(x, "d").Value TextBox5.Value = Cells(x, "e").Value TextBox6.Value = Cells(x, "f").Value TextBox7.Value = Cells(x, "g").Value TextBox8.Value = Cells(x, "h").Value TextBox9.Value = Cells(x, "i").Value TextBox10.Value = Cells(x, "j").Value TextBox11.Value = Cells(x, "k").Value TextBox12.Value = Cells(x, "l").Value TextBox13.Value = Cells(x, "m").Value TextBox14.Value = Cells(x, "n").Value TextBox15.Value = Cells(x, "o").Value TextBox16.Value = Cells(x, "p").Value TextBox17.Value = Cells(x, "q").Value TextBox18.Value = Cells(x, "r").Value TextBox24.Value = Cells(x + 1, "d").Value TextBox25.Value = Cells(x + 1, "e").Value TextBox26.Value = Cells(x + 1, "f").Value TextBox27.Value = Cells(x + 1, "g").Value TextBox28.Value = Cells(x + 1, "h").Value TextBox29.Value = Cells(x + 1, "i").Value TextBox30.Value = Cells(x + 1, "j").Value TextBox31.Value = Cells(x + 1, "k").Value TextBox32.Value = Cells(x + 1, "l").Value TextBox33.Value = Cells(x + 1, "m").Value TextBox34.Value = Cells(x + 1, "n").Value TextBox35.Value = Cells(x + 1, "o").Value TextBox36.Value = Cells(x + 1, "p").Value TextBox37.Value = Cells(x + 1, "q").Value TextBox38.Value = Cells(x + 1, "r").Value TextBox19.Value = Cells(x, "ai").Value TextBox20.Value = Cells(x, "aj").Value TextBox21.Value = Cells(x, "ak").Value Exit For Else Dim cl As Control For Each cl In Me.Controls For i = 2 To 38 If cl.Name = "TextBox" & i Then cl = "" i = i + 1 End If Next i Next cl End If Next x End Sub

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

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

اخى في الله في الملف كود اسمه test اكتب التغيرات التى تريدها في الملفات ثم شغل الكود

السلام عليكم ورحمه الله وبركاته وبها نبدأ اخى مصطفي ارفق ملف لمن يريد المساعده فهم المطلوب

تفضل اخى الكريم Sub Test() Dim SH As Worksheet, WS As Worksheet, SHLR As Long, WSLR As Long, CEL As Range Application.DisplayAlerts = False Application.EnableEvents = False Set WS = ThisWorkbook.Worksheets("Total") For Each SH In Worksheets If SH.Name <> "Total" Then With SH SHLR = SH.Cells(Rows.Count, 4).End(xlUp).Row + 1 For Each CEL In SH.Range("D14:D" & SHLR) If CEL.Value <> Empty Then WSLR = WS.Cells(WS.Rows.Count, 1).End(xlUp).Row + 1 WS.Range("A" & WSLR) = SH.Range("I14") WS.Range("B" & WSLR) = SH.Range("L14") WS.Range("C" & WSLR) = CEL.Value End If Next CEL End With End If Next SH Application.DisplayAlerts = True Application.EnableEvents = True End Sub CS_StudentRemainingCourses.xlsm CS_StudentRemainingCourses-1.xlsm

وعليكم السلام ورحمة الله وبركاته ضع هذه المعادله في الخليه a3 وغير العامود كما تريد =HYPERLINK(A100,"Go")

السلام عليكم ورحمة الله وبركاته جرب هذا التعديل اخى الكريم Sub Delete_Old_Date() Dim m As Long, r As Long, WS As Worksheet Set WS = ThisWorkbook.Worksheets("آخر حركة انقطاع ") Application.ScreenUpdating = False m = WS.Cells(WS.Rows.Count, "A").End(xlUp).Row For r = 2 To m If Application.CountIf(WS.Range("A" & r & ":A" & m), WS.Cells(r, 1).Value) > 1 Then WS.Rows(r).Delete r = r - 1 End If Next r Application.ScreenUpdating = True End Sub

وعليكم السلام ورحمه الله وبركاته اخى الكريم ما هو الشكل المتوقع لوضع البيانات في صفحه total صمم نموزج لشكل البيانات وليكن لعدد ٢ طالب لتتضح الرؤيه

السلام عليكم ورحمة الله وبركاته يمكنك الاستفاده من هذا الموضوع

السلام عليكم ورحمة الله وبركاته يمكنك الاستفاده من هذا الموضوع وايضا هذا الموضوع وهذا الموضوع به عده طرق لاستخدام التاريخ في التكست بوكس

وجزاكم مثله اخى الكريم الحمد لله الذي بنعمته تتم الصالحات

وعليكم السلام ورحمة الله وبركاته المعادله الاولى =iferror(DATE(IF(LEFT(C1232;1)="2";MID(C1232;2;2);"20"&MID(C1232;2;2));MID(C1232;4;2);MID(C1232;6;2));"") المعادله الثانيه =iferror(IF(Q1232>1;DATEDIF(Q1232;$P$1;"md");"");"")

وعليكم السلام ورحمه الله وبركاته يمكنك الاستفاده من هذا الموضوع

السلام عليكم ورحمه الله وبركاته جرب هذا التعديل اخى الكريم test2.xlsb

بعد اذن الاساتذه عدل هذا الجزء LR = Range("G" & Rows.Count).End(3).Row الي LR = Range("E" & Rows.Count).End(3).Row