أبومروان

السلام عليكم ورحمه الله وبركاته محاوله بسيطه لعله يكون المطلوب فورم شفاف للنسخ واللصق والكت show.xls

وعليكم السلام ورحمه الله وبركاته

بارك الله فيك فيديو اكثر من رائع منتظرين شروحات اكتر باذن الله

حل اخر للطلب لعله يكون المطلوب ويفي بالغرض اذا ارات البحتث من خلال فتره معينه مثلا من يوم 1 الي يوم 10 من هتكون في الخليه e3 الي هتكون في الخليه f3 كما في الصوره المرفقه Copy of جدول ورديات (1).xlsm

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

الله ينور ممكن تعمل لينا الاكود بالامثله علي الاكسل

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

وعليكم السلام ورحمه الله وبركاته اتفضل لعله يكون المطلوب جدول ورديات.xlsm

السلام عليكم ورحمه الله وبركاته يرجي ارفاق صوره او الملف بالخطا اذا كان سوالك بظهر رموز واشكال غريبه في الاكسل مثل هذا ("ÇáßÔÝ ÇáÑÆíÓí") يمكنك مرجعه الموضوعات التاليه

وعليكم السلام ورحمه الله وبركاته ما هي كلمه المرور واسم المستخدم

الحمد لله الذي بنعمته تتم الصالحات، وبفضله تتنزل الخيرات والبركات وبتوفيقه تتحقق المقاصد والغايات

وعليكم السلام ورحمه الله وبركاته اليك الحل بالكود لعله يكون المطلوب 👇 Sub SeparateSubjects() Dim ws As Worksheet Dim lastRow As Long Dim i As Long, j As Long Dim outputRow As Long Dim subjects() As String Dim subject As Variant Set ws = ThisWorkbook.Sheets(1) lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row outputRow = 6 ws.Range("D6:E1000").ClearContents For i = 6 To lastRow Dim subjectsText As String subjectsText = ws.Cells(i, "C").Value Dim seatNumber As String seatNumber = ws.Cells(i, "b").Value subjects = Split(subjectsText, " - ") For j = LBound(subjects) To UBound(subjects) ws.Cells(outputRow, "D").Value = seatNumber ws.Cells(outputRow, "E").Value = Trim(subjects(j)) outputRow = outputRow + 1 Next j Next i MsgBox "تم فصل المواد بنجاح!", vbInformation End Sub بالكود.xlsm

السلام عليكم ورحمه الله وبركاته استاذ @ashrafelsisi حاول شرح المطوب وارفاق شيت للعمل عليه ما هو الطلوب بالتحديد

اتفضل الاكواد بعد التعديل لعله يكون المطلوب واخبرنا بالنتجه اليك بعض الاكواد ممكن تساعدك كود مسح الخلايا بعد الترحيل اخر كود الترحيل وغير النطاق زاي ما هو موضع wsSrc.Range("B13:J13").ClearContents لو مش عايز ترحل لو الخلايا فارغه قبل كود الترحيل وغير النطاق زاي ما هو موضح If WorksheetFunction.CountA(wsSrc.Range("B4:J4")) = 0 Then MsgBox "الخلايا فارغة لم يتم الترحيل.", vbExclamation Exit Sub End If Sub Transfer1() Dim wsSrc As Worksheet, wsDst As Worksheet Set wsSrc = ThisWorkbook.Worksheets("Horaire2027") Set wsDst = ThisWorkbook.Worksheets("Feuil1") If WorksheetFunction.CountA(wsSrc.Range("B4:J4")) = 0 Then MsgBox "النطاق فارغ لم يتم الترحيل.", vbExclamation Exit Sub End If If WorksheetFunction.CountA(wsSrc.Range("B6:I6")) = 0 Then MsgBox "النطاق فارغ لم يتم الترحيل.", vbExclamation Exit Sub End If wsDst.Range("A6:I6").Value = wsSrc.Range("B4:J4").Value wsDst.Range("J6:Q6").Value = wsSrc.Range("B6:I6").Value End Sub Sub Transfe12() Dim wsSrc As Worksheet, wsDst As Worksheet Dim nextRow As Long Set wsSrc = ThisWorkbook.Worksheets("Horaire2027") Set wsDst = ThisWorkbook.Worksheets("Feuil12") If WorksheetFunction.CountA(wsSrc.Range("B9:J9")) = 0 Then MsgBox "النطاق فارغ لم يتم الترحيل.", vbExclamation Exit Sub End If nextRow = wsDst.Cells(wsDst.Rows.Count, "A").End(xlUp).Row If nextRow < 5 Then nextRow = 5 Else nextRow = nextRow + 1 End If wsDst.Cells(nextRow, "A").Resize(1, 9).Value = wsSrc.Range("B9:J9").Value End Sub Sub Transfe13() Dim wsSrc As Worksheet, wsDst As Worksheet Dim nextRow As Long Set wsSrc = ThisWorkbook.Worksheets("Horaire2027") Set wsDst = ThisWorkbook.Worksheets("Feuil13") If WorksheetFunction.CountA(wsSrc.Range("B13:J13")) = 0 Then MsgBox "النطاق فارغ لم يتم الترحيل.", vbExclamation Exit Sub End If nextRow = wsDst.Cells(wsDst.Rows.Count, "A").End(xlUp).Row If nextRow < 5 Then nextRow = 5 Else nextRow = nextRow + 1 End If wsDst.Cells(nextRow, "A").Resize(1, 9).Value = wsSrc.Range("B13:J13").Value wsSrc.Range("B13:J13").ClearContents End Sub Copy of Copy of Horaire-18-06-2026-(04.12.06) (3).xlsb

وعليكم السلام ورحمه الله وبركاته اتفضل الكود بالطلب الاول لعله يكون المطلوب 👇 Sub TransferDataValues() Dim wsSrc As Worksheet, wsDst As Worksheet Dim nextRow As Long Set wsSrc = ThisWorkbook.Worksheets("Horaire2027") Set wsDst = ThisWorkbook.Worksheets("Feuil1") nextRow = wsDst.Cells(wsDst.Rows.Count, "A") '.End(xlUp).Row If nextRow < 5 Then nextRow = 5 Else nextRow = nextRow End If wsDst.Cells(nextRow, "A").Resize(4, 9).Value = wsSrc.Range("B3:J6").Value End Sub اتفضل الكود بالطلب التاني لعله يكون المطلوب 👇 Sub Transfe12() Dim wsSrc As Worksheet Dim wsDst As Worksheet Dim nextRow As Long Set wsSrc = ThisWorkbook.Worksheets("Horaire2027") Set wsDst = ThisWorkbook.Worksheets("Feuil12") nextRow = wsDst.Cells(wsDst.Rows.Count, "A").End(xlUp).Row If nextRow < 5 Then nextRow = 5 Else nextRow = nextRow + 1 End If wsDst.Cells(nextRow, "A").Resize(1, 9).Value = wsSrc.Range("B9:J9").Value End Sub اتفضل الكود بالطلب التالت لعله يكون المطلوب 👇 Sub Transfe13() Dim wsSrc As Worksheet Dim wsDst As Worksheet Dim nextRow As Long Set wsSrc = ThisWorkbook.Worksheets("Horaire2027") Set wsDst = ThisWorkbook.Worksheets("Feuil13") nextRow = wsDst.Cells(wsDst.Rows.Count, "A").End(xlUp).Row If nextRow < 5 Then nextRow = 5 Else nextRow = nextRow + 1 End If wsDst.Cells(nextRow, "A").Resize(1, 9).Value = wsSrc.Range("B13:J13").Value wsSrc.Range("B13:J13").ClearContents End Sub Copy of Horaire-18-06-2026-(04.12.06) (3).xlsb

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

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

الغيابات (1).xlsx السلام عليكم ورحمه الله وبركاته شوف الملف المرفق لعله يكون المطلوب المعادله المستخدمه 👇 =IFERROR(INDEX($A$3:$A$18, SMALL(IF(COUNTIF($F$3:$F$18, $A$3:$A$18)=0, ROW($A$3:$A$18)-ROW($A$3)+1), ROWS($B$3:B3))), "")

وعليكم السلام اتفضل الكود دا لعله يكون المطلوب جرب وشوف وخبرنا بالنتجه Option Explicit Sub ارسال_رسائل_واتساب() Dim ws As Worksheet Dim LastRow As Long Dim i As Long Dim Phone As String Dim Name As String Dim Msg As String Set ws = ThisWorkbook.Sheets("رسائل اليوم") LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row For i = 2 To LastRow Name = Trim(ws.Cells(i, "A").Value) Phone = Trim(ws.Cells(i, "C").Value) Msg = Trim(ws.Cells(i, "E").Value) If Phone <> "" And Msg <> "" Then Msg = Replace(Msg, "[الاسم]", Name) Msg = WorksheetFunction.EncodeURL(Msg) ThisWorkbook.FollowHyperlink _ "https://web.whatsapp.com/send?phone=" & Phone & "&text=" & Msg Application.Wait Now + TimeValue("00:00:08") SendKeys "~", True Application.Wait Now + TimeValue("00:00:03") End If Next i MsgBox "تم إرسال جميع الرسائل", vbInformation End Sub وممكن حضرتك تتصفح المواضيع اللي تحت👇 ينمكن تلاقي اللي بتدور عليه وأكتر كما🌹 Copy of واتس اب ويب.xlsm

السلام عليكم مرفق الملف بعد التعديل لعله المطلوب Copy of Horaire-18-06-2026-(04.12.06).xlsb

وعليكم السلام ورحمه الله وبركاته يجب عليك ارفاق ملف الاكسل المراد العمل عليه نظام حماية لملف الاكسل والدخول للصفحات تشفير الملفات بدلا من استخدام انواع الحماية المختلفة مدونة اعمال ايقونات الماس لمنتدى اوفيسنا_شاشة دخول_صلاحيات_PASS WORD_اخفاء معادلات

وعليكم السلام ورحمه الله وبركاته فين دليل الايام او التاريخ اللي فيها اجازات وموجده في اي عمود يرجي التوضح اكتر للمطلوب ولعله تجد ما تريده

الإبداع في أبهى صوره @عبدالله بشير عبدالله طريقتك في التنفيذ ممتازة ونتعلم الجديد من حضرتك كل يوم

السلام عليكم ورحمة الله اتفضل تم عمل المطلوب علي حسب ما فهمت لعله يكون المطلوب مؤشر عمل اللجان.xlsm

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