saad abed

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

اخى هشام جزاك الله خيرا تحياتى سعد عابد

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

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

اخى تومى بارك الله فيك سعد عابد

اخى محمد بارك الله فيك وجزاك الله خيرا سعد عابد

اخى وحبيبى عبدالله المجرب جهد واضح اسال الله ان يديم عليك الصحة وعافيته وستره اللهم امين اخوك سعد عابد

اخوتى اكرر سؤالى عن الاستاذ عادل حنفى واخونا خبور وابوعبدالله اسال الله ان يطمنى عليهم بعد ان اطمنت على الحسامى تحياتى سعد عابد

اخى alidroos جزاك الله خيرا احسنت تم تجربة كل جزئية فى الكود فهو يعمل بكفاءة شكرا لك وبارك الله فيك اخوك سعد عابد

Private Sub Workbook_Open() .xls" thenمرتبات سعد If ActiveWorkbook.NAME = " Sheets("الترحيل").Select UserForm5.Show Else ActiveWorkbook.Close SaveChanges:=False End If End Sub اخوانى الاعضاء الكود يمنع تغيير الاسم ويظهر فورم الدخول ويجعل ورقة الترحيل هى البداية المطلوب اضافة شرط وهو انتهاء الملف عند تاريخ معين فى نفس الكود وشرحة صيغة التاريخ يوم شهر سنة مثلا شكرا لكم اخوكم سعد عابد

استاذنا محمد طاهر جزاك الله خيرا وبارك فيك سعد عابد

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

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

اخى عبدالله المجرب اولا وحشنا ووحشتنا ابداعاتك عمل كبير بكود وفكره بسيطة بارك الله فيك فلتره باربع متغيرات نتيجة ممتازة السؤال نقل التقرير فى صفحة منفصلة التغيير فى الكود هكذا ام توجد اضافات اخرى تحياتى سعد عابد Private Sub CommandButton1_Click() Application.ScreenUpdating = False Range("rng").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=sheet1.Range( _ "O1:R2"), CopyToRange:=sheet2.Range("G1:K1"), Unique:=False ActiveWindow.SmallScroll Down:=-3 Range("K2").Select Application.ScreenUpdating = True End Sub

اخى حسن حل الاستاذ هشام ممتاز وبسيط نشكره عليه اذا اردت استخدام الكود افتح الملفين الملف المرسل والملف اللى انت شغال عليه اضغط alt+f11 اسحب مديول رقم 1 الى ملفك انسخ المفتاح المكتوب علية اضغط لحذف السطور الى ملفك اضغط على المفتاح كليك يمين اختار تعيين ماكرو اختار test اخوك فى الله سعد عابد Book1.rar

اخى هذا الكود يحذف السطور الفارغة لعل هذا ما طلبت اخوك سعد عابد Sub test() Dim Lastrow As Long Dim i As Long Application.ScreenUpdating = False With ActiveSheet Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row For i = Lastrow To 2 Step -1 If Application.CountA(.Rows(i)) = 0 Then .Rows(i).Delete End If Next i End With Application.ScreenUpdating = True End Sub

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

استاذى محمد طاهر وفقك الله ما دام هذا فيه الخير لمنتدانا الحبيب تحياتى سعد عابد

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

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

اخى خبور خير اخى الحسامى اخى عادل حنفى اخى ابو عبدالله اسالكم الدعاء معى لاحبتى ان ييسر لهم امور حياتهم ويردهم الى منتدانا بخير وسلامة اللهم امين اللهم انا هؤلاء قدموا لنا يد العون فامدهم بعونك اللهم انا هؤلاء قدمو لنا يد المساعدة فساعدهم فى كل امور حياتهم اللهم امين اخوكم سعد عابد

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

اخى هشام شلبى استخدمت كودك فى الترحيل واستخدمت كود اخى عبدالله فى التعديل ولكن ظهرت مشكلة صغيرة اسالك لماذا بعد ان اضفت المعادلات فى صفحة المرتبات فى الاعمدة التى لا يرحل اليها ظهر بعدها الكود يرحل الى بداية ظهور المعادلات ولتكن مثلا a302هنا تكون بداية الترحيل من a302:a5 فارغ شكرا لك تحياتى Sub MoveValue2() Dim EndRow As Long If ورقة1.Range("c6").Value = "" Then MsgBox prompt:="تأكد من إدخال كافة البيانات", Title:="خطأ" Exit Sub End If '------------------------------------------------------------------ If Cells(2, 6) = "H" Then EndRow = ورقة2.Range("A1").CurrentRegion.Rows.Count ورقة2.Cells(EndRow + 1, 1).Value = EndRow ورقة2.Cells(EndRow + 1, 2).Value = ورقة1.Cells(8, 3).Value ورقة2.Cells(EndRow + 1, 3).Value = ورقة1.Cells(9, 3).Value ورقة2.Cells(EndRow + 1, 4).Value = ورقة1.Cells(10, 3).Value ورقة2.Cells(EndRow + 1, 5).Value = ورقة1.Cells(11, 3).Value ورقة2.Cells(EndRow + 1, 6).Value = ورقة1.Cells(12, 3).Value ورقة2.Cells(EndRow + 1, 7).Value = ورقة1.Cells(2, 1).Value ورقة2.Cells(EndRow + 1, 8).Value = ورقة1.Cells(7, 5).Value ورقة2.Cells(EndRow + 1, 10).Value = ورقة1.Cells(8, 5).Value ورقة2.Cells(EndRow + 1, 12).Value = ورقة1.Cells(9, 5).Value ورقة2.Cells(EndRow + 1, 14).Value = ورقة1.Cells(10, 5).Value ورقة2.Cells(EndRow + 1, 15).Value = ورقة1.Cells(11, 5).Value ورقة2.Cells(EndRow + 1, 16).Value = ورقة1.Cells(12, 5).Value MsgBox prompt:="تم ترحيل البيانات بنجاح", Title:="رسالة تأكيد" '------------------------------------------------------------------ Else EndRow = ورقة2.Range("A1").CurrentRegion.Rows.Count ورقة2.Cells(EndRow + 1, 1).Value = EndRow ورقة2.Cells(EndRow + 1, 3).Value = ورقة1.Cells(6, 3).Value ورقة2.Cells(EndRow + 1, 5).Value = ورقة1.Cells(11, 3).Value ورقة2.Cells(EndRow + 1, 7).Value = ورقة1.Cells(2, 1).Value MsgBox prompt:="تم ترحيل البيانات بنجاح", Title:="رسالة تأكيد" End If End Sub

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

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