iyadshahwan قام بنشر مارس 8, 2011 قام بنشر مارس 8, 2011 السلام عليكم... اخواني انا اعمل على برنامج لطباعة الوصفات الطبية وقد استفدت كثيراً من مواضيعكم ومشاركاتكم التي اسأل الله ان يجزيكم كل خير عليها,وارجو منكم تزويدي بكود او دالة لترحيل قيمة خلية معينة لورقة أخرى بمجرد النقر عليها وذلك بترتيب تنازلي بحسب اختيارها(اي تكون الخلية المختارة أولاً في السطر الاول والخلية المختارة ثانياً في السطر الثاني وهكذا...) وجزاكم الله كل خير
عبدالله باقشير قام بنشر مارس 8, 2011 قام بنشر مارس 8, 2011 السلام عليكم حسب ما فهمت من طلبك هذا الكود موجود في موديل الورقة المواد Option Explicit '========================================= ' تعيين النطاق الذي تريد الترحيل منه ' يتكون من عمود واحد وعدة صفوف Private Const MyRang As String = "C3:C100" '========================================= ' اسم الورقة التي تريد الترحيل لها Private Const MyShName As String = "ورقة الترحيل" ' اسم الخلية الاولى في النطاق المرحل له Private Const MyColmn As String = "B3" '========================================= Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Application.Intersect(Target, Range(MyRang)) Is Nothing Then If Target <> "" Then Cancel = True kh_RangeCopy Target End If End If End Sub '========================================= Private Function kh_RangeCopy(Rng As Range) Rng.Copy With Worksheets(MyShName) .Select With .Range(MyColmn) .Select .Insert Shift:=xlDown End With End With Application.CutCopyMode = False End Function يمكنك التغيير حسب معطياتك في بداية الكود المرفق اكسل 2003 نسخ خلية بالنقر عليها الى ورقة بترتيب تنازلي.rar
iyadshahwan قام بنشر مارس 8, 2011 الكاتب قام بنشر مارس 8, 2011 اخي العزيز خبور خير لا اعلم حقيقةً كيف اشكرك على حسن تعاملك وسرعة استجابتك لطلبي جزاك الله كل خير وزادك من علمه وكرمه شكراً شكراً..... اخوك في الله اياد
محمدي عبد السميع قام بنشر مارس 10, 2011 قام بنشر مارس 10, 2011 ماشاء الله عمل ولاأروع منه جزاك الله خيرا
خالدو قام بنشر مارس 10, 2011 قام بنشر مارس 10, 2011 جزاكم الله خيراً اخواني مش ممكن نستغل نفس الكود ان يرحل كل الصف الخاص بالخلية السالبة في العمود B في كل الورقة؟؟؟ لمزيد من الايضاح ارجو مراجعة الملف المرفق. ولكم جزيل الشكر Posting.rar
عبدالله باقشير قام بنشر مارس 11, 2011 قام بنشر مارس 11, 2011 السلام عليكم الاخ : خالد حسب ما فهمت من طلبك المرفق اكسل2003 Posting.rar
خالدو قام بنشر مارس 12, 2011 قام بنشر مارس 12, 2011 جزاكم الله خيراً أخي خبور والله عمل رائع ولكن عندما حاولت ادخال < 0 أي القيم الاصغر من صفر وطلبت الترحيل أعطاني رسالة خطأ. هل من الممكن معالجة هذا الأمر .. وأكرر شكري الجزيل لكم. بارك الله فيكم
عبدالله باقشير قام بنشر مارس 12, 2011 قام بنشر مارس 12, 2011 السلام عليكم بارك الله فيك اخي محمدي اخي خالد جزاك الله خيرا ولكن عندما حاولت ادخال < 0 أي القيم الاصغر من صفر وطلبت الترحيل أعطاني رسالة خطأ. هل من الممكن معالجة هذا الأمر اذا كنت تريد القيم الاصغر من الصفر بشكل دائم غير السطر التالي من الكود: If CDbl(Me.Cells(R, 4)) = CDbl(Me.Range("F2")) Then بالسطرالتالي: If CDbl(Me.Cells(R, 4)) < 0 Then
خالدو قام بنشر مارس 12, 2011 قام بنشر مارس 12, 2011 جزاك الله خيراً أخي خبور التعديل الأخير فعلاً شغال. بارك الله فيكم.
الردود الموصى بها
انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد
يجب ان تكون عضوا لدينا لتتمكن من التعليق
انشئ حساب جديد
سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .
سجل حساب جديدتسجيل دخول
هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.
سجل دخولك الان