حرود قام بنشر مارس 16, 2015 قام بنشر مارس 16, 2015 سلام عليكم ورحمة الله وبركاته دمتم جميعا احبتي في الله بكل خير وعافية وسعادةلسلام عليكم ورحمة الله وبركاته دمتم جميعا احبتي في الله بكل خير وعافية وسعادة عاوز تعديل هاد الكود ترحيل فاتورة من (2b) حتى (54b) ترحيل في شيت mat Sub AddData() Application.ScreenUpdating = False smsm.Range("d12").Select If smsm.Range("d12").Value = "" Then MsgBox "الرجاء ادخال الاسم قبل عملية الاضافة" Exit Sub End If Dim en As Longen = good.Range("e15000").End(xlUp).Row + 1 good.Cells(en, 4) = smsm.Range("d10").Value good.Cells(en, 5) = smsm.Range("d11").Value good.Cells(en, 6) = smsm.Range("d12").Value good.Cells(en, 7) = smsm.Range("c15").Value good.Cells(en, 8) = smsm.Range("d15").Value good.Cells(en, 9) = smsm.Range("e15").Value good.Cells(en, 10) = smsm.Range("c16").Value good.Cells(en, 11) = smsm.Range("d16").Value good.Cells(en, 12) = smsm.Range("e16").Value good.Cells(en, 13) = smsm.Range("c17").Value good.Cells(en, 14) = smsm.Range("d17").Value good.Cells(en, 15) = smsm.Range("e17").Value good.Cells(en, 16) = smsm.Range("c18").Value good.Cells(en, 17) = smsm.Range("d18").Value good.Cells(en, 18) = smsm.Range("e18").Value good.Cells(en, 19) = smsm.Range("c19").Value good.Cells(en, 20) = smsm.Range("d19").Value good.Cells(en, 21) = smsm.Range("e19").Value good.Cells(en, 22) = smsm.Range("c20").Value good.Cells(en, 23) = smsm.Range("d20").Value good.Cells(en, 24) = smsm.Range("e20").Value good.Cells(en, 25) = smsm.Range("c21").Value good.Cells(en, 26) = smsm.Range("d21").Value good.Cells(en, 27) = smsm.Range("e21").Value good.Cells(en, 28) = smsm.Range("c22").Value good.Cells(en, 29) = smsm.Range("d22").Value good.Cells(en, 30) = smsm.Range("e22").Value good.Cells(en, 31) = smsm.Range("c23").Value good.Cells(en, 32) = smsm.Range("d23").Value good.Cells(en, 33) = smsm.Range("e23").Value good.Cells(en, 34) = smsm.Range("c24").Value good.Cells(en, 35) = smsm.Range("d24").Value good.Cells(en, 36) = smsm.Range("e24").Value good.Cells(en, 37) = smsm.Range("c25").Value good.Cells(en, 38) = smsm.Range("d25").Value good.Cells(en, 39) = smsm.Range("e25").Value good.Cells(en, 40) = smsm.Range("c26").Value good.Cells(en, 41) = smsm.Range("d26").Value good.Cells(en, 42) = smsm.Range("e26").Value good.Cells(en, 43) = smsm.Range("c27").Value good.Cells(en, 44) = smsm.Range("d27").Value good.Cells(en, 45) = smsm.Range("e27").Value good.Cells(en, 46) = smsm.Range("c28").Value good.Cells(en, 47) = smsm.Range("d28").Value good.Cells(en, 48) = smsm.Range("e28").Value good.Cells(en, 49) = smsm.Range("c29").Value good.Cells(en, 50) = smsm.Range("d29").Value good.Cells(en, 51) = smsm.Range("e29").Value good.Cells(en, 52) = smsm.Range("c30").Value good.Cells(en, 53) = smsm.Range("d30").Value good.Cells(en, 54) = smsm.Range("e30").Value good.Cells(en, 55) = smsm.Range("c31").Value good.Cells(en, 56) = smsm.Range("d31").Value good.Cells(en, 57) = smsm.Range("e31").Value good.Cells(en, 58) = smsm.Range("c32").Value good.Cells(en, 59) = smsm.Range("d32").Value good.Cells(en, 60) = smsm.Range("e32").Value good.Cells(en, 61) = smsm.Range("c33").Value good.Cells(en, 62) = smsm.Range("d33").Value good.Cells(en, 63) = smsm.Range("e33").Value good.Cells(en, 64) = smsm.Range("c34").Value good.Cells(en, 65) = smsm.Range("d34").Value good.Cells(en, 66) = smsm.Range("e34").Value good.Cells(en, 66) = smsm.Range("e34").Value good.Cells(en, 3) = smsm.Range("e9").Value smsm.Range("d11:e11,d12:e12,c15:e34").ClearContents good.Range("b8:h1000").Sort Key1:=good.Range("b8"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal smsm.Range("e9") = smsm.Range("e9") + 1 smsm.Range("c11").Select End Sub الفاتورة.zip
شوقي ربيع قام بنشر مارس 16, 2015 قام بنشر مارس 16, 2015 السلام عليكم اولا لم اجد الكود السابق في الملف المرفق ثانيا توجد حاجا اسمها الحلاقات التكرارية تغنيك عن مئات الاسطر وهذا التعديل للكود الذي ادرجته اعلاه على حسب فهمي للطلبك Sub AddData() Application.ScreenUpdating = False smsm.Range("d12").Select If smsm.Range("d12").Value = "" Then MsgBox "ÇáÑÌÇÁ ÇÏÎÇá ÇáÇÓã ÞÈá ÚãáíÉ ÇáÇÖÇÝÉ" Exit Sub End If Dim en As Long: en = good.Range("e15000").End(xlUp).Row + 1 Dim i As Long: For i = 2 To 54 good.Cells(en, i) = smsm.Range("d" & i + 8).Value Next smsm.Range("d11:e11,d12:e12,c15:e34").ClearContents good.Range("b8:h1000").Sort Key1:=good.Range("b8"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal smsm.Range("e9") = smsm.Range("e9") + 1 smsm.Range("c11").Select End Sub 1
حرود قام بنشر مارس 16, 2015 الكاتب قام بنشر مارس 16, 2015 السلام عليكم اخي شوقي ربيع بارك لله فيك انا لم ادرج الكود في الملف تاركت الخيار لي من يرد تعديل الملف ارجو منك اضافت الكود في الملف لو سمحت ليس عندي خبرا في اللكواد اسال الله ان يفرج همك
ياسر خليل أبو البراء قام بنشر مارس 18, 2015 قام بنشر مارس 18, 2015 (معدل) أخي الحبيب قم بنسخ الكود الذي تفضل به العلامة شوقي ربيع وفي ملفك اضغط Alt + F11 ثم أدرج موديول جديد من القائمة Insert ثم الصق الكود .. حاولت أطبقه على ملفك لكن ملفك يعطيني رسالة خطأ عند محاولة فتحه يرجى رفعه من جديد أخي الكريم تم تعديل مارس 18, 2015 بواسطه YasserKhalil
ياسر خليل أبو البراء قام بنشر مارس 18, 2015 قام بنشر مارس 18, 2015 سجلت لك هذا الفيديو أخي الحبيب اطلع على رابط الموضوع http://www.officena.net/ib/index.php?showtopic=59867
حرود قام بنشر مارس 18, 2015 الكاتب قام بنشر مارس 18, 2015 نعم اخي اطلعت على المشاركة رقم 8 هل تقصد ان نتبقى الكود في الملف
ياسر خليل أبو البراء قام بنشر مارس 18, 2015 قام بنشر مارس 18, 2015 نعم أخي تبقي الكود في الملف ، لكي تستطيع أن تستخدمه !! وإلا قد أكون أسأت في فهم سؤالك ..
حرود قام بنشر مارس 18, 2015 الكاتب قام بنشر مارس 18, 2015 (معدل) اخي ياسر لو كان بامكاني مطالب المساعدة لقد مت انا المساعدة لي الاخرين بارك الله فيك على صبر معي و نصيحة تم تعديل مارس 18, 2015 بواسطه حرود
ياسر خليل أبو البراء قام بنشر مارس 18, 2015 قام بنشر مارس 18, 2015 أخي الحبيب : هل أنت عربي ؟؟ أشعر أنك تستخدم جوجل في الترجمة للعربية ؟ لو كنت مجيد للإنجليزية اكتب بالانجليزي ما تريده ..حتى أدرك ما تريده بالضبط
شوقي ربيع قام بنشر مارس 18, 2015 قام بنشر مارس 18, 2015 السلام عليكم Sub test() Dim ws1 As Worksheet: Set ws1 = Sheets("invoice") Dim ws2 As Worksheet: Set ws2 = Sheets("mat") Dim lrw1 As Long: lrw1 = ws1.Cells(Rows.Count, "C").End(xlUp).Row Dim lrw2 As Long: lrw2 = ws2.Cells(Rows.Count, "F").End(xlUp).Row + 1 Dim i As Byte: i = lrw2 - 1 + lrw1 - 9 If ws1.Range("D10") = "" Then Exit Sub Dim ii As Byte: For ii = lrw2 To i ws2.Range("C" & ii).Value = ws1.Range("E3").Value ws2.Range("D" & ii).Value = ws1.Range("I3").Value ws2.Range("E" & ii).Value = ws1.Range("E5").Value ws2.Range("M" & ii).Value = ws1.Range("E7").Value Next ws2.Range("F" & lrw2 & ":L" & i).Value = ws1.Range("D10:J" & lrw1).Value ws1.Range("C10:J" & lrw1).Value = "" End Sub الفاتورة_2.zip
حرود قام بنشر مارس 18, 2015 الكاتب قام بنشر مارس 18, 2015 اخى شوقي ربيع اشكرك على الاهتمام بارك الله فيك
الردود الموصى بها
انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد
يجب ان تكون عضوا لدينا لتتمكن من التعليق
انشئ حساب جديد
سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .
سجل حساب جديدتسجيل دخول
هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.
سجل دخولك الان