ناصر سعيد

الله يحفظكم

اخي الكريم المحترم ياسر ... اريد وضع كودكم الرائع مع فورمه لكلمه سز وهتاخد كلمه السر من خليه زد 3 .. في صفحة بيانات الطلبه ' Sub CopyRow(sSheet As String, sRow As Long, LC As Long) 'إلغاء تحديث الشاشة ' (الغاء مشاهدة تنفيذ الماكرو) Application.ScreenUpdating = False Dim Ws As Worksheet Dim cnt As Long 'سطر لتفادي حدوث خطأ في حالةأن الخلايا ' التي سيتم مسحها أي الخلايا الثابتة كانت فارغة On Error Resume Next Set Ws = Sheets(sSheet) On Error GoTo 0 If Ws Is Nothing Then MsgBox "ورقة " & sSheet & " غير موجودة.", vbExclamation, "Sheet Not Found!" Exit Sub End If '[B10] تعيين قيمة للمتغير ليساوي قيمة الخلية 'من صفحة بيانات المدرسة cnt = Sheets("بيانات المدرسة").Range("B10").Value Ws.Range(Ws.Cells(sRow, 1), Ws.Cells(sRow, LC)).Copy Ws.Range("A" & sRow).Resize(cnt).PasteSpecial xlPasteAll On Error Resume Next ' يقوم بمسح الخلايا الثابتة في النطاق المنسوخ بحيث ' يبقى على المعادلات والتنسيق فقط ويزيل ما دون ذلك Ws.Range("A" & sRow).Resize(cnt, LC).SpecialCells(xlCellTypeConstants, 3).ClearContents Application.CutCopyMode = False End Sub Sub DoIt() CopyRow "بيانات الطلبة", 7, 22 CopyRow "إنجاز1", 7, 26 CopyRow "رصد الترم الأول", 7, 108 CopyRow "أعمال السنة", 7, 26 CopyRow "رصد الترم الثانى", 7, 189 CopyRow "كنترول شيت", 11, 189 Range("A1").Activate ' تحديث الشاشة Application.ScreenUpdating = True End Sub جزاك الله خيرا

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

جزاك الله خيرا العدد الذي يتم نسخ صفوفه يزيد واحد عن العدد المكتوب يعني لو كتبنا 25 في صفحة بيانات المدرسه يتم نسخ 26 صف ربنا يجعلها لك دائما سهله ربنا يبارك لك

اخي الكريم ياسر الكود اكثر من رااائع عند اضافة ورقه جديده تتم بسرعه ايضا ولكن لايأخذ نفس ارتفاع الصف المطلوب النسخ منه

ربنا يبارك لك... بقت تتم وتقف على اخر صفحه وهي كنترول شيت واحنا عايزينه يتم الكود في صمت وتظل صفحه بيانات الطلبه هي المفتوحه جزاك الله خيرا

ربنا يبارك لك وموضوع ظهور التحديد هل يمكن ازالته

راااااااااااااااااااااااائع يا ابو المفهوميه يا استاذ ياسر خليل الكود سريع وسهل .. الله يحفظك ويبارك لك .. الله يحفظك ويبارك لك .. الله يحفظك ويبارك لك ... ولكن بعد اجراء الكود الصفحات تظهر باللون الداكن كأنها محده فممكن لو تكرمت نزيل هذا التحديد ممكن شرح لهذه الاسطر Ws.Range("A" & sRow + 1).Resize(cnt, LC).SpecialCells(xlCellTypeConstants, 3).ClearContents Application.CutCopyMode = False هذه الاكواد ستعمل مع اكواد حمايه .. لعدم التعارض فقط

جزاك الله خيرا مش عارف احمل الكود الموقع ...... ارجو وضع الكود مباشره في المنتدى او http://www.up-00.com/ ولك خالص شكري وتقديري او احد الاحوه اللي نجحوا في تحميل الكود يعيد رفعه ويجزيه الله خيرا

جزاك الله خيرا مش عارف احمل الكود الموقع ...... ارجو وضع الكود مباشره في المنتدى او http://www.up-00.com/ ولك خالص شكري وتقديري

تقضل استاذ ياسر المرفق بدون دمج اريد تطبيق الكود على جميع الاوراق الموجوده بالمرفق لتسهيل العمل وليجعل الملف خقيف الحجم وجزاك الله خيرا 1ادراج عدد محدد من الصفوف 2.rar

بارك الله فيكم

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

Sub KH_Copy() On Error Resume Next Dim Last As Long Dim Count As Integer Count = 1 Count = Sheets("KHBOOR").Range("F9").Value With ActiveSheet A = .Cells(1, 1).End(xlDown).Offset(2, 0).Row .Range(Cells(A, 1), Cells(Rows.Count, 5)).EntireRow.Delete Last = .Range("A" & .Rows.Count).End(xlUp).Row .Rows(Last).Copy .Rows(Last).Resize(Count) .Rows(Last).Resize(Count).SpecialCells(xlConstants).ClearContents End With On Error GoTo 0 End Sub هل يمكن تطويع هذا الكود ليعمل في ملقي المرفق بالمشاركة الاولى نسخ صفوف بعدد معين مع الاحتفاظ بالمعادلات.rar عايز اي حل يا احبابي

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

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

للرفع رفع الله مقداركم

جزاك الله كل خير اخي المحترم ياسر خليل في صفحة بيانات اساسيه يوجد عدد في الخليه B10 هذا العدد متغير لانه عدد طلبه الصف الدراسي وكل صف دراسي له عدد مختلف ... في صفحة بيانات الطلبه يوجد زر مكتوب عليه نسخ البيانات بعدد الطلاب المطلوب : عند الضغط على هذا الزر الموجود بصفحة بيانات الطلبه يتم نسخ الصف السابع في جميع الاوراق الموجوده بالملف ماعدا ورقة كنترول شيت سيكون النسخ من الصف 12 بالطبع لن يكون النسخ للصف كاملا وانما بطول الراس الموجوده في كل صفحة بمعنى آخر يوجد في كل صفحة راس مسطره ومكتوب بها بيانات ..... تحتها مباشرة يوجد صف هذا الصف هو المطلوب بسخه بعدد الطلاب وبعرض راس الصفحة وشكرا مقدما

شكرا لردك ربنا يبارك فيك هذا هو

السلام عليكم ورحمة الله وبركاته اخواني في الله هذا الملف به كود لاحد عمالقة المنتدى وهو الاستاذ ابو تامر بارك الله له ولكم والكود يعمل جيدا ولكنه يعمل بادراج الصفوف من مواقع مختلفه والملف خاصتي به عدة اوراق اريد جزاكم الله خيرا ان يعمل هذا الكود من موقع ثابت دائما كما في الصفحات وان ياخذ العدد من صفحة بيانات اساسيه ادراج عدد محدد من الصفوف بصيغ الصف الحالى فى اوراق محددة.rar Option Base 1 Sub Test() MySheets = Array("ورقة1", "ورقة2", "ورقة3") R = ActiveCell.Row Count = 2 If vRows = 0 Then Count = Application.InputBox(Prompt:=" ادخل عدد الصفوف ", Title:=" ادراج عدد محدد من صفوف ", Default:=1, Type:=1) If Count = False Then Exit Sub End If Application.ScreenUpdating = False For x = 1 To UBound(MySheets) Sheets(MySheets(x)).Select Rows(R).Offset(1, 0).Resize(Count).EntireRow.Insert: Rows(R).AutoFill Rows(R).Resize(Count + 1), xlFillDefault Rows(R).Offset(1).Resize(Count).EntireRow.SpecialCells(xlConstants).ClearContents Next Sheets(MySheets(1)).Select Application.ScreenUpdating = True End Sub الكود هو

جزاكم الله خيرا

خلاص .. خلصت طلبك ومابتردش علينا

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

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

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