الـعيدروس

جزاك الله خير اخي ابا الحسن على كلماتك الطيب استبدل هذه السطرين VBA.Calendar = vbCalHijri LastOpen = Format(Date, "dd/mm/yyyy") & " _ " & Time بهذه VBA.Calendar = vbCalGreg LastOpen = Format(Date, "yyyy/mm/dd") & " _ " & Time

الاستاذ الحبيب احمد حمور ( أبو عبدالله) حفظك الله ورعاك مرورك الكريم شرف كبير ونعتز به تعلمنا على يديكم ومانقدمه انما نقلدكم تقبل تحياتي وشكري

السلام عليكم تفضل اخي ابو الحسن صفحة صلاحيات 1_ديناميكية.rar

السلام عليكم تفضل T_ALIDROOS.rar

السلام عليكم ماالقصود يتوقف رقم الجلوس و السرى عند الرقم الاجمالى للطلبة ؟؟؟

السلام عليكم استبدل هذا الكود Range("b3" & Ligne) = TextBox1 بهذا [B3] = Val(TextBox1) والطلب الاخر غير واضح

السلام عليكم جزاك الله استاذ عبدالله المجرب بعد اذن الاستاذ الحبيب عبدالله اضافة بسيطه على الكود في حال المدى متغير Sub Abu_Ahmed() Dim cl As Range For Each cl In Range("G1:G" & Cells(Rows.Count, 7).End(xlUp).Row) If Application.CountIf(Range("A1:D" & Cells(Rows.Count, 4).End(xlUp).Row), cl) = 0 Then Range("E" & Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Row) = cl Next End Sub

السلام عليكم ابداع في ابداع استاذ عبدالله حفظك الله من كل شر وزادك علماً الى علمك تقبل مروري

استاذ محمد صالح بعد تنصيب dotnetframework NET يعمل 100% جزاك الله كل خير

يعني الشرط في خلية B2 ؟؟ اذا تكرر اسم القسم لايرحل هل هكذا تريد

السلام عليكم استاذ محمد صالح حفظك الله ورعاك انا تظهر عندي رسالة خطاء

استبدل هذا السطر Union(SH_ALI.Range("A3:A" & R), SH_ALI.Range("E3:E" & R), SH_ALI.Range("F3:F" & R)).Copy بهذا SH_ALI.Range(Cells(R, 1), Cells(R, 39)).Copy

اين هيا خلية ig ؟ If [G1].Value <> Empty Then Range("A1:C1").PrintOut End If

ممكن تعمل Prtscr للخطاء وترفق الصورة ؟

السلام عليكم جزاك الله خير استاذ عبدالله (خبور خير)

اشكرك استاذ عبدالله على التوضح فعلا شاهدة المرفق ورأيت مايقصد ولاكن اخي aghanem تعرف ان البرنامج هو برنامج لفندق والفنادق معروفه تجيك ناس من كل الجنسيات اضن انك قسيت في نقطة بغير محلها مجرد رأي ؟

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

السلام عليكم الاخ الفاضل أبو الحسن جرب المرفق GAFAR_F_ALL_1.rar

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

جزا الله كل خير استاذ عبدالله فعلا انت صائغ اكواد بمعنى الكلمة

الحمد لله

السلام عليكم تحايلنا بحذف الصفوف ذات القيمة صفر Sub COPY_ALIDROOS() On Error Resume Next Dim W_ALI As Workbook, WB_ALI As Workbook, N_ALI$, CH_ALI$, SH_ALI As Worksheet Dim T%, R% Dim X As Range ' Dim S_A ' S_A = Union(SH_ALI.Range("A3:A" & R), SH_ALI.Range("E3:E" & R), SH_ALI.Range("F3:F" & R)) Application.ScreenUpdating = 0 '============================================ ' هنا تحط مسار مجلد الملفات التي تريد جلب بياناتها CH_ALI = "C:\Mine\" '============================================ N_ALI = Dir(CH_ALI & "\*.xlsx") Set W_ALI = ThisWorkbook Do While N_ALI <> "" Set WB_ALI = Workbooks.Open(CH_ALI & "\" & N_ALI) For Each SH_ALI In WB_ALI.Worksheets R = SH_ALI.Cells(Rows.Count, 1).End(xlUp).Row W_ALI.Activate '============================================ '(A-E-F)هنا الاعمدة المراد جلب بياناتها هيا حسب طلبك هيا ' إبتداء من السطر الثالث If SH_ALI.Range("C3:C" & R).Value <> 0 Then Union(SH_ALI.Range("A3:A" & R), SH_ALI.Range("E3:E" & R), SH_ALI.Range("F3:F" & R)).Copy '============================================ T = Cells(Rows.Count, 1).End(xlUp).Row + 1 ThisWorkbook.Worksheets(1).Range("A" & T).PasteSpecial xlPasteValues End If Next SH_ALI N_ALI = Dir WB_ALI.Close 0 Loop With ورقة1 For Each X In .Range("C3:C5000") If X.Value = 0 Then X.EntireRow.Delete End If Next X End With Application.ScreenUpdating = 1 End Sub

اطلع على المرفق ان شاء الله يكون المطلوب GAFAAR_A1.rar

اذا ماهو الشرط للمكرر اذا كلو بيكون منه 2 اذا ماهو الشرط المراد ؟؟ لم استوعب ماتريد السموحه مزيد من التوضيح والا ربما كالعادة السهر بيعمل عمايله معي

اخي عيد ماهو الشرط المراد بالضبط ارجو التوضيح اكثر كيف اصغر من 0 واكبر من 0 ؟؟