الصـقر

الاخوة الكرام اليوم ان شاء الله سنكمل كيفية عمل الترحيل بشروط لو رجعنا الى المشاركة رقم 1 ونظرنا على شكل كود الترحيل النهائى كان كالتالى Sub ترحيل() Application.ScreenUpdating = False If [G7] = "" Or [d8] = "" Or [d10] = "" Or [d11] = "" Then MsgBox "الرجاء ادخال جميع بيانات السند": Exit Sub With Sheet4 Lr = .Cells(.Rows.Count, "D").End(xlUp).Row .Cells(Lr + 1, "A") = [d8] .Cells(Lr + 1, "B") = [G7] .Cells(Lr + 1, "D") = [d10] .Cells(Lr + 1, "G") = [d11] .Cells(Lr + 1, "E") = "=R[-1]C+RC[2]-RC[1]" End With End Sub طبعا الكود فى شرط واحد وهو هذا السطر ( يعنى لا ينفذ الكود لو كان فى خليه من الخلايا المذكور فارغه ليس بها بيانات If [G7] = "" Or [d8] = "" Or [d10] = "" Or [d11] = "" Then MsgBox "الرجاء ادخال جميع بيانات السند": Exit Sub طيب انا عايز اعمل شرط لو نوع السند بالخليه G6 نقدى ينفذ الكود ولو مش نقدى مش ينفذ كل اللى هنعمله هنستخدم if If [G6] = "نقدى" Then السطر قاعدة if ده هيكون مكانه فين فى الكود أعلاه هيكون بعد هذا السطر Lr = .Cells(.Rows.Count, "D").End(xlUp).Row وطبعا طالما فتحنا if أذن لابد من قفلها ب end if قبل هذا السطر من الكود End With وهيصبح الكود بشكل النهائى كالتالى Sub ترحيل() Application.ScreenUpdating = False If [G7] = "" Or [d8] = "" Or [d10] = "" Or [d11] = "" Then MsgBox "الرجاء ادخال جميع بيانات السند": Exit Sub With Sheet4 Lr = .Cells(.Rows.Count, "D").End(xlUp).Row If [G6] = "نقدى" Then .Cells(Lr + 1, "A") = [d8] .Cells(Lr + 1, "B") = [G7] .Cells(Lr + 1, "D") = [d10] .Cells(Lr + 1, "G") = [d11] .Cells(Lr + 1, "E") = "=R[-1]C+RC[2]-RC[1]" End If End With End Sub وبكدا الكود اصبح فى شرطين الشرط الاول وهو عدم ترك الخلايا فارغه لو فى خلية فارغه يطلع من الكود وميكملش طيب لو كل البيانات مكتوبه ينتقل للشرط التالى وهو والشرط الثانى وهو اذا كان السند نقدى يتم الترحيل غير كدا لا ميرحلش طيب عايز اعمل شرط ثالث لو كان G6 شيك هيكون بهذا الشكل If [G6] = "شيك" Then .Cells(Lr + 1, "A") = [d8] .Cells(Lr + 1, "B") = [G7] .Cells(Lr + 1, "D") = [d10] .Cells(Lr + 1, "i") = [d11] .Cells(Lr + 1, "j") = "=R[-1]C+RC[-1]-RC[-2]" End If هنا عملنا قاعدة if جديده لو كانت الخلية G6 شيك نفذ التالى طيب الشرط ده هيكون فين موقعه من الكود بتاعنا الاصلى هيكون كالتالى Sub ترحيل() Application.ScreenUpdating = False If [G7] = "" Or [d8] = "" Or [d10] = "" Or [d11] = "" Then MsgBox "الرجاء ادخال جميع بيانات السند": Exit Sub With Sheet4 Lr = .Cells(.Rows.Count, "D").End(xlUp).Row If [G6] = "نقدى" Then .Cells(Lr + 1, "A") = [d8] .Cells(Lr + 1, "B") = [G7] .Cells(Lr + 1, "D") = [d10] .Cells(Lr + 1, "G") = [d11] .Cells(Lr + 1, "E") = "=R[-1]C+RC[2]-RC[ End If If [G6] = "شيك" Then .Cells(Lr + 1, "A") = [d8] .Cells(Lr + 1, "B") = [G7] .Cells(Lr + 1, "D") = [d10] .Cells(Lr + 1, "i") = [d11] .Cells(Lr + 1, "j") = "=R[-1]C+RC[-1]-RC[-2]" End If End With End Sub يعنى الكود هيروح لاول شرط ملئ جميع البيانات لو تمام هينتقل للشرط الاخر وهو لو الخلية G6 نقدى هينفذ سطور التالية ولو شيك هينفذ السطور التالية وطبعا قفلنا if بعد كل مره يوجد ملف مرفق للتجربه وفى النهاية تقبلوا منى وافر الاحترام والتقدير خزينة.zip

أخى الكريم سيف الدين حسام اولا يجب عمل قائمة منسدله فى الخلية G6 للاختيار منها اذا كان السند نقدى او شيك انظر الملف المرفق علشان نبدء نشتغل على كيفية الترحيل الى نقذا والترحيل لو شيك تقبل تحياتى خزينة.zip

اخى الفاضل / جلال الجمال - ابوادهم أشكرك على مرورك العطر بخصوص طلب حضرتك ارجوا منك ارفاق ملف موضوح به ما تريد فى موضوع جديد وان شاء الله نشرح كيفية عمل ما تريد خطوة خطوة تقبل منى وافر الاحترام والتقدير

أخى الكريم yasiressa جزاك الله كل خير وشكرا على مرورك العطر تقبل تحياتى

الاخوة الكرام بالمنتدى اليوم أن شاء الله سنكمل شرح دروس الترحيل كيفية عمل سريل تلقائى لسند لعمل سريل تلقائى يتم فى خطوتين الخطوة الاولى : هى ادراج المعادله التاليه فى الخلية C1 كما هو موضح بالصورة المرفقه =MAX(حركة الخزينة!B5:B100000)+1 المعادله دى هى معادله Max ايجاد اكبر قيمة فى العمود B بشيت حركة الخزينة 1 +( النطاق ثم ! كتابة اسم ورقة العمل المراد ايجاد اكبر قيمة فى العمود بداخلها ) max = سنلاحظ بعد كتابة اسم الورقه متبوعه ب علامه التعجب ! لمعرفة المزيد عن داله Max يرجى مراجعه الرابط التالى http://www.officena.net/ib/index.php?showtopic=58127#entry370483 أذا كان الاوفيس 2010 او 2013م سنستخدم هذا المعادله =MAX('حركة الخزينة'!B5:B100000)+1 هى نفس المعادله السابقه ولكن الزياده هنا هى هذه العلامه ( ' ) قبل اسم الورقه وبعدها ( وهذه العلامه تكتب بجعل اللغه انجلش ثم الضغط على حرف ط ) بصراحه ايه فرق صيغه المعادله من 2007 الى 2010 او 2013 صراحه مش عارف لو فى احد من الخبراء يفسرو لنا هذا نكون شاكرين نرجع للمثال بتاعنا طبعا الفايل المرفق للشرح فى اول مشاركة وهو خزينة تم تصميمه على 2013م لذالك سنستخدم المعادله الثانية فى الخلية c1 كما هو بالصورة النتيجة كما هى بالصورة عاليه 1 ( وبالطبع هى نتيجة صحيحة لان شيت حركة الخزينة العمود B لم يسجل اى سند لذالك النتيجة 1) الخطوة الثانية : جعل الخلية G7 =C1 كما هو مبين بالكود التالى نقوم بادراج مودويل جديد ولصق هذا الكود فيه Sub جديد() [G7] = [c1] [d8] = "" [d10] = "" [d11] = "" End Sub ثم الرجوع الى زر ايصال جديد الموجود بالسند وتعيين الماكرو علية كليك يمين على الزر ستظهر قائمة اختار منها تعيين الماكرو سيظهر لك شاشة اختار منها جديد وقم بالضغط على الزر وشوف النتيجة ستجد 1 لو سجلت سند ثم قمت بعملية الترحيل وضغط زر جديد ستجد رقم الايصال اصبح 2 وتم مسح البيانات بخانه التاريخ وخانه المستلم والمبلغ ولجعل شغلك اكثر احترافيه غير لون خلفيه الخلية C1 ولون الخط بها على نفس اللون حتى لا يظهر ما بداخل الخلية مرفق ملف للتجربة العملية ********* ملحوظه انا بستخدم بالشرح اسهل الطرق وايسرها ارجوا من الله ان اكون وفقت بالشرح ويستفيد منه الجميع تقبلوا منى وافر الاحترام والتقدير خزينة.zip

أخى الكريم واستاذى الحبيب سيف الدين حسام يا غالى سلمت على كلماتك الرائعه وانا لا استحق كل هذا فأنا والله مثلك مبتدء وبتعلم بس كل الفكرة انى عايز اوصل للناس اللى انا عارفه زى ما عرفته اوصله تقبل تحياتى وتقديرى لشخصك الكريم

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

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

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

اخى الكريم تفضل الكود بيكون بهذا الشكل Sub hossam() Q = MsgBox("هل تحب اوفيسنا", vbYesNo) If Q = vbNo Then MsgBox "طيب ليه وأوفيسنا بتخدمنا كلنا": Exit Sub End If If Q = vbYes Then MsgBox "أوفيسنا بتموت فيك" End If End Sub تقبل تحياتى

الاخوة الكرام قبل البدء فى شرح كيفية عمل سريل تلقائى لسند قبض او صرف او فاتورة يرجى متابعه الرابط التالى أولا http://www.officena.net/ib/index.php?showtopic=58127#entry370299 تقبلوا تحياتى

أخى الغالى أ/ احمد دائما وابدا سباق بالخير شكرا على مرورك العطر ولك بمثل ما دعوة به وان يجمعنا بالجنه ان شاء الله تقبل تحياتى وتقديرى

الاخوة الكرام فى المنتدى الغالى أقدم لكم شرح مبسط للداله MAX والداله Min أولا : الداله Max 1-اسم الداله هى اختصار Maximum والترجمه الحرفيه لها هى أعلى قيمة أو الحد الاقصى 2- شكل الداله بالاكسيل MAX ( number1 , number2 , ... ) ويمكن كتابة 30 رقم بين الاقواس بحد اقصى هذا الشكل يستخدم عندما نريد معرفه اكبر قيمة فى عدة خلايا متفرقه الشكل الاخر للداله =MAX(range start : range end) هذا الشكل يستخدم عندما نريد معرفه اكبرقيمة فى مجموعه من الخلايا المتتابعه بشكل راسى او اوفقى ثانيأ : الداله Min 1- اسم الداله هى اختصار Minimum والترجمه الحرفيه لها هى اقل قيمة أو الحد الادنى 2- شكل الداله MIN ( number1 , number2 , ... ) ويمكن كتابة 30 رقم بين الاقواس بحد اقصى هذا الشكل يستخدم عند نريد معرفه اكبر قيمة فى عدة خلايا متفرقه الشكل الاخر للداله =Min(range start : range end) هذا الشكل يستخدم عندما نريد معرفه اقل قيمة فى مجموعه من الخلايا المتتابعه بشكل راسى او اوفقى ********************************************************************************* حتى يتضح لنا معنى الكلام الهيلوغريفى ده لازم شرح بالصور والامثله العمليه مثال 1 لدينا مجموعه من الخلايا المتفرقه كما هو موضخ بالصورة المرفقه ونريد معرفه اكبر قيمة تم كتابة داله Max بالخلية ( K1 ) =MAX(A2;C3;C7;B12;E8;F4) زى ما احنا شايفين بالمعادله ان بعد كتابة كل خلية متبوعه بهذه العلامه ( ; ) وتكتب من خلال جعل لغة الكيبور انجلش ثم الضغط على حرف ك بالعربى من الكيبور وكما هو واضح بالصورة ان اكر قيمة هى 9 المظلله باللون الاصفر وهى بالطبع اكبر قيمة مثال 2 فى نفس المثال السابق وعلى نفس الصورة نريد معرفه اقل قيمة تم كتابة داله Min بالخلية ( K1 ) =MIN(A2;C3;C7;B12;E8;F4) وكانت النتيجة 2 وهى بالطبعه اقل قيمة من القيم الموجوده بالصورة مثال 3 نريد معرفه اكبر قيمة من الخلايا من A1 الى A10 كما هو بالصورة المرفقه تم كتابة المعادله بالخلية K1 والمظلله باللون الاصفر =MAX(A1:A10) ثم كتابة المعادله كالتالى a1 ( وهى بداية النطاق المراد معرفه اكبر قيمه فيه ) ثم هذه العلامه ( : ) (نقطتين فوق بعض - تكتب شيفت + حرف ك بالكيبور) ثم A10 (وهى نهاية النطاق المراد معرفه اكبر قيمه فيه ) النتيجة كما هو واضح بالصورة 10 وبالطبع هى اكبر قيمة مثال 4 نريد معرفه اقل قيمة من الخلايا من A1 الى A10 كما هو بالصورة المرفقه تم كتابة المعادله بالخلية K1 والمظلله باللون الاصفر =MIN(A1:A10) ثم كتابة المعادله كالتالى a1 ( وهى بداية النطاق المراد معرفه اقل قيمه فيه ) ثم هذه العلامه ( : ) (نقطتين فوق بعض - تكتب شيفت + حرف ك بالكيبور) ثم A10 (وهى نهاية النطاق المراد معرفه اقل قيمه فيه ) النتيجة كما هو واضح بالصورة 1 وبالطبع هى اقل قيمة مثال 5 الداله max و الداله Min تتعامل مع الارقام فقط وتتجاهل النصوص لو نظرنا للصورة التالية نلاحظ هنا ان الداله اعطت النتيجة 0 لماذا لانها لا تتعامل مع النصوص فهى تتعامل مع الارقام فقط مثال 6 الداله max و الداله Min لا تتعامل مع نطاق احدى الخلايا به فيها Error فكما هو موضح بالصورة احدى الخلايا بالنطاق فيه Error على الرغم من وجود رقم 3 و 5 والمفترض ان النتيجة للمعادله هى 5 / ولكن النتيجة كما هو بالمعادله بالخلية( K1 ) هى Error ارجوا من الله ان اكون وفقت بالشرح وان يستفيد منه الجميع تقبلوا تحياتى واحترامى للجميع

اخى الكريم يرجى ارفاق ملف حتى يتضح لنا طلبك تقبل تحياتى

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

استاذى الحبيب حسب فهمى لطلب السائل الملف المرفق صحيح 100% ارجوا الافاده ان كان به خطا تقبل تحياتى

الاخت الكريمة جربى المعادله التالية فى الخلية G2 ثم سحبها الى اسفل =IF(F2-INT(F2)>=0.5;F2-INT(F2)-0.5;F2-INT(F2)) مرفقك ملفك بعد التعديل تقبلى تحياتى الحافز.zip

استاذنا الكبير استاذى الفاضل شوقى ربيع مجرد مرورك حضرتك بالموضوع فهذا شرف لى ما بالك مشاركتك فأنا مهما قلت فلن اعبر عن مدى سعادتى بالمشاركة تعليقاتك ونقدك فانا اتقبلها بصدر رحب وهى وسام على صدرى فانا بتعلم منك واستفد منك الكثير من قبل وبخصوص ملاحظاتك على الموضوع 1- ارجاع الوظيفة الاضافيه لتثبيت الشاشه فعلا معك كل الحق والله انا كنت هذكرها بس بعد الانتهاء من باقى الشروحات المتعلقه بالترحيل 2-الدرس هو تبسيط المعلومه وتوصيلها للمبتدئين فكنت اختار ايسر الطرق واسهلها واقوم بشرح كل نقطة وكل سطر حتى يسهل على الاخوة الجدد التعلم ومن ثم يكون انطلاقتهم بالمنتدى ومعرفه اكثر من طريقه لنفس الموضوع واخير انا منتظر من حضرتك مشاركات من حضرتك اكتر انا عايز استفيد منك واستفيض من علمك تقبل منى وافر الاحترام والتقدير

اخى الكريم اللى مش عارفه اسمه اولا ارجو من حضرتك تغيير الاسم للعربيه طبقا لقواعد المنتدى ثانيا شكر خاص لحضرتك لحرصك على التعلم والاصرار علية بخصوص اين الخطا بالكود الكود بتاع حضرتك كما هو بالمرفق عاليه Sub Tarheel() Dim LR As Integer Application.ScreenUpdating = False With sheet2 LR = .Cells(.Row.Count, "D").End(xlUp).Row .Cells(LR + 1, "D") = [E6] .Cells(LR + 1, "E") = [H6] .Cells(LR + 1, "F") = [K6] .Cells(LR + 1, "G") = [E10] .Cells(LR + 1, "H") = [H10] .Cells(LR + 1, "i") = [K10] [E6] = "" [H6] = "" [K6] = "" [E10] = "" [H10] = "" [K10] = "" End With End Sub الخطاء هنا اولا : هو هذا السطر LR = .Cells(.Row.Count, "D").End(xlUp).Row يتم تعديله الى LR = .Cells(.Rows.Count, "D").End(xlUp).Row الفرق هو Rows بدلا من RoW ثانيا : هذا السطر With sheet2 وتعديله هو With ورقة2 لو رجعت للشرح وشوف الصورة دى هتجد اننا استخدمنا sheet4 وهى خارج القوس لماذا لان الاوفيس عندك عربى والاصل لأسماء الشيتات بمحرر الاكواد العربية ملكش دعوه بالاسم اللى داخل القوس استخدم دائما وابدا الاسم خارج القوس لو جربت تعدل اسم sheet2 بالمرفق وادخل محرر الاكود ستجد برضوا اسمه ورقة2 ثالثا: هذا السطر Dim LR As Integer وجوده او عدم وجوده لا يؤثر فى شئ رابعا : اعجاب اعجبت جدا انك فكرت تبدع وتطور فى الكود واضافه مسح الخلايا بعد الترحيل برافو عليك انت فنان (اتبعت اعرف معلومه واستنتج الاخرى ) [E6] = "" [H6] = "" [K6] = "" [E10] = "" [H10] = "" [K10] = "" تقبل تحياتى وشكرا لحضرتك مره اخرى

اخى الكريم RR يمكن الاستغناء عنها وحذفها ولا يوثر على عمل الكود ستظهر الرساله عادى تقبل تحياتى

اخى عبدالله بلنوار الكود التالى موجود بحدث الملف Private Sub Workbook_Open() Dim i As Integer On Error Resume Next For i = 2 To Sheets.Count Sheets(i).Visible = xlSheetVeryHidden Next End Sub عند الدخول يقوم باخفاء الصفحات من 2 الى اخر صفحه تقبل تحياتى

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

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

الاخوة الكرام اقدم لكم بقية لدرس الترحيل كيفية وضع شروط تجبر المستخدم على ادخال بيانات مما لا شك فيه ان سند القبض اللى بصورة التالية لابد من ادخال جميع البيانات اللى بالسند وهى المظلله باللون الاصفر رقم الايصال بالخلية [G7] تاريخ السند بالخلية [D8] الجهه التى تم القبض منها بالخلية [D10] المبلغ المقبوض بالخلية [D11] ان شاء الله اليوم بنتعرف كيف يمكن اجبار المستخدم على ادخال البيانات قبل ترحيلها فلا يعقل مثلا ان يقوم المستخدم بعدم كتابه تاريخ للسند ويترك الخلية فارغه بدون تاريخ ثم يقوم بالترحيل لازم اجبره على ادخال التاريخ اولا: اجبار المستخدم على ادخال رقم الايصال بالخلية [G7] هنستخدم السطر التالى بالكود If [g7] = "" Then MsgBox "الرجاء ادخال رقم الايصال": Exit Sub هذا السطر يتم اضافتة بعد هذا السطرمن الكود Application.ScreenUpdating = False ليصبح هكذا Sub ترحيل() Application.ScreenUpdating = False If [g7] = "" Then MsgBox "الرجاء ادخال رقم الايصال": Exit Sub With Sheet4 Lr = .Cells(.Rows.Count, "D").End(xlUp).Row .Cells(Lr + 1, "A") = [D8] .Cells(Lr + 1, "B") = [g7] .Cells(Lr + 1, "D") = [D10] .Cells(Lr + 1, "G") = [d11] .Cells(Lr + 1, "E") = "=R[-1]C+RC[2]-RC[1]" End With End Sub تعالى بقى نشرح معنى هذا السطر If [g7] = "" Then MsgBox "الرجاء ادخال رقم الايصال": Exit Sub هذا السطر من الكود معناه ببساطه كدا ان لو الخلية [g7] فارغه اكتب رساله تظهر للمستخدم تنبهه بان الخلية فارغه ويجب ادخالها و اخرج من الكود ومتكملش الشىئ الذى تريد تنفيذه then الشرط المطلوب التحقق من وجوده if استخدمنا هنا IF وذالك لعمل شرط قبل عملية الترحيل وهى كما نعرف جميعا ان iF معناها لو then معناها تنفيذ الشرط الذى نريده كما اتفقنا من قبل هو عدم ترك الخلية [g7] فارغه اللى بيسجل بها رقم الايصال الكود هيقوم باختبار الشرط التالى "" = [if [g7 "" العلامه هذا بالكود تعنى فارغ ( فلو [g7] تساوى فارغ نفذ كذا كذا ) نفذ دى فى الكود هى Then وسيكون لونها بالكود ازرق هينفذ ايه بقى انا عايزة يظهر رساله وهى " الرجاء ادخال رقم الايصال" ونلاحظ انها مكتوبه بين علمتى تنصيص ( تكتب من خلال شيفت + حرف ط بالكيبور) وهينفذ ايه تانى غير الرساله هينفذ خروج من الكود ميكملش يعنى ودى بتكون exit sub : وبعدها كتابتها ستجد ان لونها اصبح ازرق لمتابعه شرح عن كتابة الرسائل فى لغة البرمجه يرجى مراجعه الرابط التالى ستجد شرح باستفاضه http://www.officena.net/ib/index.php?showtopic=57199&hl= ) ثانيا : عايزين نجبر المستخدم على ادخال التاريخ If [d8] = "" Then MsgBox "الرجاء ادخال تاريخ لسند القبض": Exit Sub هو نفس السطر السابق بس بنختبر الخليه [d8] فيها تاريخ ام لا ثالثا : اجبار المستخدم على ادخال الجهه التى تم الاستلام منها If [d10] = "" Then MsgBox "الرجاء ادخال اسم الشخص الذى تم الاستلام منه": Exit Sub رابعا: اجبار المستخدم على ادخال المبلغ المقبوض If [d11] = "" Then MsgBox "الرجاء ادخال المبلغ المقبوض": Exit Sub وهيكون الكود فى شكله النهائى كالتالى Sub ترحيل() Application.ScreenUpdating = False If [g7] = "" Then MsgBox "الرجاء ادخال رقم الايصال": Exit Sub If [d8] = "" Then MsgBox "الرجاء ادخال تاريخ لسند القبض": Exit Sub If [d10] = "" Then MsgBox "الرجاء ادخال اسم الشخص الذى تم الاستلام منه": Exit Sub If [d11] = "" Then MsgBox "الرجاء ادخال المبلغ المقبوض": Exit Sub With Sheet4 Lr = .Cells(.Rows.Count, "D").End(xlUp).Row .Cells(Lr + 1, "A") = [d8] .Cells(Lr + 1, "B") = [g7] .Cells(Lr + 1, "D") = [d10] .Cells(Lr + 1, "G") = [d11] .Cells(Lr + 1, "E") = "=R[-1]C+RC[2]-RC[1]" End With End Sub يعنى الكود قبل الترحيل هيعمل اربع اختبارات الاول هيمسك اول سطر بتاع رقم الايصال لو موجود ينتقل للسطر اللى بعده ولو مش موجود هبخرج من الكود ومش هيكمل وهكذا ما باقى الاسطر الين يتحقق من وجود بينات بالاربع خلايا ثم يقوم بعمليه الترحيل خامسا : هل يمكن عمليه الاختبار بسطر واحد بدلا من اربع اسطر نعم يمكن ذالك من خلال السطر التالى If [g7] = "" Or [d8] = "" Or [d10] = "" Or [d11] = "" Then MsgBox "الرجاء ادخال جميع بيانات السند": Exit Sub هنا تم استخدام داله OR وهى تعنى أو لو الخلية اللى بها رقم الايصال فارغه أو الخلية اللى بها التاريخ فارغه او الخلية اللى بها الجهه التى تم استلام المبلغ منها أو الخلية اللى بها المبلغ فارغه نفذ رساله ثم اخرج من الكود ومتكملش ويكون الكود بشكله النهائى كالتالى Sub ترحيل() Application.ScreenUpdating = False If [g7] = "" Or [d8] = "" Or [d10] = "" Or [d11] = "" Then MsgBox "الرجاء ادخال جميع بيانات السند": Exit Sub With Sheet4 Lr = .Cells(.Rows.Count, "D").End(xlUp).Row .Cells(Lr + 1, "A") = [d8] .Cells(Lr + 1, "B") = [g7] .Cells(Lr + 1, "D") = [d10] .Cells(Lr + 1, "G") = [d11] .Cells(Lr + 1, "E") = "=R[-1]C+RC[2]-RC[1]" End With End Sub وفى النهاية ارجوا ان اكون وفقت بالشرح واتمنى ان يستفيد منه الجميع تقبلوا منى وافر الاحترام والتقدير

استاذ / سامى جرب الرابط التالى فيه برنامج يمكن يعجبك http://www.officena.net/ib/index.php?showtopic=57962&hl= بخصوص طلبك على حسب فهمى جرب المرفق التالى تقبل تحياتى الاستاذ.zip