محمد فاروق محمود قام بنشر مارس 16, 2013 مشاركة قام بنشر مارس 16, 2013 ارجو من حضراتكم مساعدتى فى تعديل على عمل مميز لاحد السادة المحترفين واريد تعديل فى ترحيل الترحيل بالفلترة - ترويسة و تذييل بالكود.rar رابط هذا التعليق شارك More sharing options...
أبو محمد أشرف قام بنشر مارس 17, 2013 مشاركة قام بنشر مارس 17, 2013 أرجو التوضيح أكثر أخي تقصد آخر عمود للترحيل المجموع وليس آخر صف وأرجو مزيد توضيح بالنسبة للعبارة للمجمع بحيث يكون صفوف 25-50-75 رابط هذا التعليق شارك More sharing options...
محمد فاروق محمود قام بنشر مارس 17, 2013 الكاتب مشاركة قام بنشر مارس 17, 2013 شكرا يا اخ اشرف على الاهتمام برجاء مساعدتى على اساس ان الترحيل يكون ثابت على اساس 25 صف وكونت اود ان يخصص cد اخر صف فى كل مرة ترحيل لعمل مجموع للعمو وشكرا شكرا على المرور الكريم برجاء مساعدتى عندما يتم تحدي الثابت على اثاث 25 صف للترحيل كنت اود ان يجعل اخر صف للمجموع ويكون المجموع للعمود سى وشكرا الحمد لله توصلت لخانة المجموع ويتبقى ترحيل راسب فى صفحة ناجح بدا من صف 177 والغاء صفحة راسب توضيح اكثر للمطلوب برجاء المساعدة الترحيل بالفلترة - ترويسة و تذييل بالكود.rar رابط هذا التعليق شارك More sharing options...
أفضل إجابة احمد عبد الناصر قام بنشر مارس 18, 2013 أفضل إجابة مشاركة قام بنشر مارس 18, 2013 السلام عليكم جرب هذا الكود Sub dahmour() Application.ScreenUpdating = False With Sheets(1) .Select .AutoFilterMode = False lastrow = Range("a" & Rows.Count).End(xlUp).Row .Range("A1:D" & lastrow).AutoFilter .Range("A1:D" & lastrow).AutoFilter Field:=4, Criteria1:="ناجح" .Range("a2:d" & lastrow).Copy Sheets(2).Range("a1") .AutoFilterMode = False End With ''''''''''''''''''''''''''''''' With Sheets(2) .Select x = 1 Do Sheets(1).Range("a1:d1").Copy .Range("a" & x & ":d" & x).Insert Shift:=xlDown x = x + 21 Rows(x & ":" & x + 3).Insert Shift:=xlDown Cells(x + 3, 3) = "=SUM(R[-24]C:R[-1]C)" x = x + 4 If IsEmpty(Cells(x, 2)) Then Exit Do Loop End With '88888888888888888888888888888888888888888888888888888888 With Sheets(1) .Select .AutoFilterMode = False lastrow = Range("a" & Rows.Count).End(xlUp).Row .Range("A1:D" & lastrow).AutoFilter .Range("A1:D" & lastrow).AutoFilter Field:=4, Criteria1:="راسب" .Range("a2:d" & lastrow).Copy Sheets(2).Range("a" & x) .AutoFilterMode = False End With ''''''''''''''''''''''''''''''' With Sheets(2) .Select r = x Do Sheets(1).Range("a1:d1").Copy .Range("a" & r & ":d" & r).Insert Shift:=xlDown r = r + 21 Rows(r & ":" & r + 3).Insert Shift:=xlDown Cells(r + 3, 3) = "=SUM(R[-24]C:R[-1]C)" r = r + 4 If IsEmpty(Cells(r, 2)) Then Exit Do Loop End With Application.CutCopyMode = False ''''''''''''''''''''''''''''''' Application.ScreenUpdating = True End Sub تحياتي رابط هذا التعليق شارك More sharing options...
محمد فاروق محمود قام بنشر مارس 18, 2013 الكاتب مشاركة قام بنشر مارس 18, 2013 حل احترافى جزاك الله كل الخير رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.