زوهير قام بنشر يناير 14, 2012 قام بنشر يناير 14, 2012 السلام عليكم ورحمة الله هل ممكن هذا الاجراء وهو الترحيل من ورقة الى اخرى لكن هناك صفين للترحيل وفي حالة عدم اكتمال لمعطيات في الصفين يرحل الذي به معطيات فقط دون الاخر والمرفق يوضح ذلك وبارك الله فيكم مسبقا TESTE5.rar
عبدالله المجرب قام بنشر يناير 14, 2012 قام بنشر يناير 14, 2012 جرب هذا الكود Private Sub CommandButton1_Click() w = 2 Do Until Cells(w, 1).Value = "" For i = 1 To 4 Sheets("BDORDR").Cells(w, i) = Cells(w, i) Next w = w + 1 Loop End Sub
زوهير قام بنشر يناير 14, 2012 الكاتب قام بنشر يناير 14, 2012 شكرا لك اخي على الاستجابة الكود يقوم بترحيل الى نفس المكان وانا اريده ان يوضيف المعطيات تحت التي سبقتها مع تنسيق الجدول ان امكن وبارك الله فيك اخي مسبقا
عبدالله المجرب قام بنشر يناير 14, 2012 قام بنشر يناير 14, 2012 إذاً جرب هذا Private Sub CommandButton1_Click() w = 2 Do Until Cells(w, 1).Value = "" LR = Sheets("BDORDR").Range("A" & Rows.Count).End(xlUp).Row For i = 1 To 4 Cells(w, i).Copy Sheets("BDORDR").Cells(LR + 1, i) Next w = w + 1 Loop End Sub
زوهير قام بنشر يناير 14, 2012 الكاتب قام بنشر يناير 14, 2012 بارك الله فيك اخي الكريم هو المطلوب بذات جزاك الله خيرا اخي
زوهير قام بنشر يناير 14, 2012 الكاتب قام بنشر يناير 14, 2012 (معدل) الاخ والاستاذ عبدالله المجرب لقد قمت بالتعديل على الكود الذي اعطيته لي في استخدام اخر ولم ينجح مع انه في الحالة الاولى يعمل بشكل جيد والمرفق يوضح لك ذلك وجزاك الله خيرا واعذرني على الالحاح ترحيل بشروط.rar تم تعديل يناير 14, 2012 بواسطه زوهير
خالد القدس قام بنشر يناير 14, 2012 قام بنشر يناير 14, 2012 السلام عليكم سلمت يداك أستاذ عبدالله المجرب وبارك الله فيك
زوهير قام بنشر يناير 14, 2012 الكاتب قام بنشر يناير 14, 2012 الاخ الاستاذ عبدالله المجرب ارجوا منك التعديل غي الكود السالف ذكره بالمرفق " ترحيل بشروط لاني وقعت بمشكلة ترحيل المعادلات
الـعيدروس قام بنشر يناير 14, 2012 قام بنشر يناير 14, 2012 السلام عليكم بعد اذن استاذي الحبيب عبدالله المجرب تعديل بسيط على الكود جرب هكذا للحالة الثانية Private Sub CommandButton2_Click() Application.ScreenUpdating = False w = 10 Do Until Cells(w, 1).Value = "" LR = Sheets("BDORDR").Range("A" & Rows.Count).End(xlUp).Row For i = 1 To 4 Cells(w, i).Copy Sheets("BDORDR").Cells(LR + 1, i).PasteSpecial xlPasteValues Sheets("BDORDR").Cells(LR + 1, i).Borders.Color = 2 Application.CutCopyMode = False Next w = w + 1 Loop Application.ScreenUpdating = True End Sub
زوهير قام بنشر يناير 14, 2012 الكاتب قام بنشر يناير 14, 2012 بارك الله فيك اخي الكريم الكود اتي بحقه المطلوب اشكرك كثيرا جزاك الله كل خير وزادك علما
الردود الموصى بها
انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد
يجب ان تكون عضوا لدينا لتتمكن من التعليق
انشئ حساب جديد
سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .
سجل حساب جديدتسجيل دخول
هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.
سجل دخولك الان