الـعيدروس

السلام عليكم جزاك الله خير استاذ طارق محمود على اكوادك الرائعة وسهله الفهم جعلها الله في ميزان حسناتك بعد اذن استاذنا الحبيب استعن بهذا الكود كي يقوم بحذف السطور من a25:az5000 في جميع الاوراق Sub cle_ali() Dim i As Integer On Error GoTo ali For i = ActiveWorkbook.Sheets.Count To 1 Step -1 Application.ScreenUpdating = False ActiveWorkbook.Sheets(i).Range("a25:az5000").Clear Next i ali: Application.ScreenUpdating = True End Sub بعدها سوي حفظ بأسم للملف وحطه في سطح المكتب ثم ارفقه بمشاركه

السلام عليكم بعد اذن استاذنا الفاضل عبدالله المجرب تفضل اخي عدلت لما يتناسب لملفك من كود للاستاذ القدير خبور خير ارجو المساعدة1.rar

تفضل AUTO SAVE IF CHANGE1.rar

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

السلام عليكم بعد اذن الاستاذ القدير طارق محمود والاستاذ يوسق عطا اخي السائل اذا كنت تقصد يتعامل مع مسمى الورقة الاصلية كي يتسنى لك تغير المسمى الافترضي للورقة دون تأثر الكود هذا كود الاستاذ مع اضافة تسريع الكود والورقة الاصليه Sub Tareq_ترحيل() Application.ScreenUpdating = False Application.EnableEvents = False Range("A4:K60000").ClearContents For Sh = 2 To Sheets.Count R = Sheets(Sh).[B10000].End(xlUp).Row Range(Sheets(Sh).[b2], Sheets(Sh).Cells(R, "K")).Copy ورقة1.[B60000].End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues Next Sh Application.CutCopyMode = False MsgBox ("!تم الترحيل بنجاح") [A4] = 1 For i = 2 To [B60000].End(xlUp).Row - 3 Cells(i + 3, 1) = i Next i [A2].Select Application.ScreenUpdating = True Application.EnableEvents = True End Sub تحياتي

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

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

السلام عليكم الاستاذ القدير احمد حمور عمل رائع ومتقن كما عودتنا ودايما نتعلم منك كل جديد نور الله قلبك ودربك للخير وفعله تقبل مروري

وعليكم السلام الاستاذ الحبيب والخلوق جدا طارق محمود جزئية حذف سطور (يعتمد) تم معي بهذا الجزء لم استخدم الفلترة Application.ScreenUpdating = False Sheets("ورقة1").Select LastRow = Cells(Rows.Count, 1).End(xlUp).Row For y = LastRow To 2 Step -1 If Cells(y, "g").Value = "يعتمد" Then Rows(y).EntireRow.Delete Next y Application.ScreenUpdating = True جزاك الله خير ونور دروبك كما تنورنا بالعلم

السلام عليكم استاذنا القدير حاولت اضيف على كودك طلبي الاخير وزبط معي الحمد لله هذا الكود بعد الاضافة للفائده العامة Sub T_shift() file1 = ActiveWorkbook.Name pth = ActiveWorkbook.Path f2Name = "قاعدة بيانات.xls" file2 = pth & "\" & f2Name On Error Resume Next 'إحتياطي لإحتمال ان يكون ملف قاعدة بيانات مفتوح بالفعل Set F_check = Excel.Workbooks(f2Name) If Err = 0 Then GoTo 10 Workbooks.Open Filename:=file2 10 'وضع خط أسفل آخر قيم في ملف قاعدة بيانات rr = Workbooks(f2Name).Sheets(1).[A1000].End(xlUp).Row Workbooks(f2Name).Sheets(1).Range("A" & rr & ":G" & rr).Borders(xlEdgeBottom).LineStyle = xlContinuous Workbooks(f2Name).Sheets(1).[a1].Select Workbooks(file1).Activate ' نسخ قيم فقط للبيانات التي توافق الشرط For a = 2 To [G1000].End(xlUp).Row If Cells(a, 7) = "يعتمد" Then Range(Cells(a, 1), Cells(a, 7)).Copy Workbooks(f2Name).Sheets(1).[A1000].End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues ic = ic + 1 End If Next a Application.CutCopyMode = False Application.ScreenUpdating = False Sheets("ورقة1").Select LastRow = Cells(Rows.Count, 1).End(xlUp).Row For y = LastRow To 2 Step -1 If Cells(y, "g").Value = "يعتمد" Then Rows(y).EntireRow.Delete Next y Application.ScreenUpdating = True 'وضع خط مرة أخري أسفل آخر قيم في ملف قاعدة بيانات rr = Workbooks(f2Name).Sheets(1).[A1000].End(xlUp).Row Workbooks(f2Name).Sheets(1).Range("A" & rr & ":G" & rr).Borders(xlEdgeBottom).LineStyle = xlContinuous 'رسالة بالبيانات المرحلة MsgBox (" تم ترحيل عدد" & ic & " بيان معتمد بنجاح") [a1].Select Workbooks(f2Name).Activate Range("A" & rr + 1).Select 'رسالة أخري من ملف قاعدة بيانات للتأكيد MsgBox "!تمام", vbInformation + vbMsgBoxRight, "تم الترحيل" Workbooks(file1).Activate With Workbooks(f2Name) .Save .Close End With End Sub

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

السلام عليكم الاساتذه الكرام لي طلب مهم واتعشم فيكم الخير لدي ملف يسجل فيه بيانات اريد ترحيل البيانات الى ملف اخر يعتبر قاعدة بيانات والترحيل يكون بشرط كلمة (يعتمد) و (غير معتمد) الصف الذي شرطه ( يعتمد) يرحل الى ملف الاكسل المسمى قاعدة البيانات وغير معتمد لايرحل وهكذا ملف ادخال البيانات المسمى (ترحيل) ارجو ان يكون طلبي واضح اليكم المرفق fold.rar

السلام عليكم الاستاذ القدير طارق محمود كود جميل وشرح ولااروع جزاك الله خير وجعله في ميزان حسناتك

الاخ الاستاذ مجدي يونس مشكور وجزاك الله خير على المجهود الطيب الى الامام

تم إضافة الملف الى المشاركة الاولى

السلام عليكم الاساتذة الاعزاء حفظكم الله لي طلب بسيط وهو معادلة لجمع الغياب في جدول الغياب جمعه عباره عن كسور بمعنى الخلايا التي باللون الاحمر ومعادلة لجمع التأخير في جدول التأخير كدقايق جمعه كوقت وهيا الخلايا ذا اللون الازرق الفاتح وتوضيح للطلب اكثر على المرفق ملاحظة خلايا فترة الصباح هيا ( k7:an7 ) خلايا فترة المساء هيا ( k9:an9 ) ولكم جزيل الشكر ح التأخير.rar

السلام عليكم ماذا تريد ان يقرائها غير تنسيق الخلايا الى ارقام يمكن تزبط او ربما هكذا .Offset(1, 0) = TextBox6.Value للتكست الذي تريد ان يرحل قيمة وليس تكست تحياتي

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

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

السلام عليكم وانا بعد لم اتمكن من تشغيلة استخدم اوفيس 2007 ومشكور على البرنامج جعله الله في ميزان حسناتك الى الامام

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

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

السلام عليكم الاستاذ عبدالله المجرب تسلم على الكود الجميل وفقك الله الى الامام

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

السلام عليكم الاخ الحبيب سعد عابد كود روعة فعلا تسلم ننتظر المزيد والمزيد وفقك الله تقبل مروري