mhrrd قام بنشر مارس 18, 2012 مشاركة قام بنشر مارس 18, 2012 السلام عليكم ورحمة الله هذا كود ممتاز ولكن اريد اضافة المسح قبل نسخ الصفوف ====== السلام عليكم ماذا لو أردنا أن يضيف الكود عدد من الصفوف محدد بقيمة في خلية ما في صفحة أخرى غير التي نعمل عليها؟؟؟؟ استخدم مثلا الكود التالي: 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 Last = .Range("A" & .Rows.Count).End(xlUp).Row .Rows(Last).Copy .Rows(Last + 1).Resize(Count) .Rows(Last + 1).Resize(Count).SpecialCells(xlConstants).ClearContents End With On Error GoTo 0 End Sub رابط هذا التعليق شارك More sharing options...
mhrrd قام بنشر مارس 18, 2012 الكاتب مشاركة قام بنشر مارس 18, 2012 اختر العدد 10 لاضافة 10 صفوف ثم بعدها اختر العدد 3 لاضافة 3 صفوف تجد الصفوف ال 10 موجودة ولا نريد ذلك نريد المسح ثم اضافة عدد الصفوف الجديدة رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر مارس 18, 2012 مشاركة قام بنشر مارس 18, 2012 (معدل) السلام عليكم السموحه توضيح اكثر تم تعديل مارس 18, 2012 بواسطه alidroos رابط هذا التعليق شارك More sharing options...
cat101 قام بنشر مارس 18, 2012 مشاركة قام بنشر مارس 18, 2012 هذه اضافه فد تفي بالغرض ولكن لم اوفق في جعل عدد الصفوف الاجمالي مساوي للعددد الكتوب في صفحة خبور الخليه F9 KH_COPY.rar رابط هذا التعليق شارك More sharing options...
cat101 قام بنشر مارس 18, 2012 مشاركة قام بنشر مارس 18, 2012 ممكن يكون هناك مع الاخوة العلماء حلول افضل من حلي رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر مارس 18, 2012 مشاركة قام بنشر مارس 18, 2012 (معدل) تفضل عرفت طلبك من حل الأخ الفاضل cat101 وبعد اذنه تفضل 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 + 1).Resize(Count) .Rows(Last + 1).Resize(Count).SpecialCells(xlConstants).ClearContents End With On Error GoTo 0 End Sub تم تعديل مارس 18, 2012 بواسطه alidroos رابط هذا التعليق شارك More sharing options...
cat101 قام بنشر مارس 18, 2012 مشاركة قام بنشر مارس 18, 2012 تفضل عرفت طلبك من حل الأخ الفاضل cat101 وبعد اذنه تفضل 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 + 1).Resize(Count) .Rows(Last + 1).Resize(Count).SpecialCells(xlConstants).ClearContents End With On Error GoTo 0 End Sub السلام عليكم ورحمة الله اخي العلامه العيداروس تستأذن مني وانت اعلم مني حقا علامة فاضل رابط هذا التعليق شارك More sharing options...
cat101 قام بنشر مارس 18, 2012 مشاركة قام بنشر مارس 18, 2012 هذه اضافه فد تفي بالغرض ولكن لم اوفق في جعل عدد الصفوف الاجمالي مساوي للعددد الكتوب في صفحة خبور الخليه F9 العلامة العيداروس لم اوفق في جعل عدد الصفوف الاجمالي مساوي للعددد الكتوب في صفحة خبور رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر مارس 18, 2012 مشاركة قام بنشر مارس 18, 2012 السلام عليكم الاخ الفاضل cat101 حفظك الله كلنا نتعلم من بعض نحنو في بداية الطريق وفقك الله لما فيه الخير هل نتائج الكود مزبوطه ؟ رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر مارس 19, 2012 مشاركة قام بنشر مارس 19, 2012 (معدل) السلام عليكم وجرب هكذا 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(1, 0).Row .Range(Cells(A, 1), Cells(Rows.Count, 5)).EntireRow.Delete With Cells(A, 1) .FormulaR1C1 = "=ROW()-9" .Font.Size = 12 .Font.Bold = True .Offset(0, 4).FormulaR1C1 = "=SUM(RC[-4]:RC[-1])" .Offset(0, 4).Font.Size = 20 .Offset(0, 4).Font.Bold = True End With With Cells(A, 1).Resize(1, 5) .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .Borders.Color = 1 .Font.Color = RGB(0, 51, 102) End With 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 تم تعديل مارس 19, 2012 بواسطه alidroos رابط هذا التعليق شارك More sharing options...
cat101 قام بنشر مارس 19, 2012 مشاركة قام بنشر مارس 19, 2012 الاستاذ الفاضل العيداروس الكود الموجود بالمشاركة رقم 6 افضل لانها ليست محدودة بمعادلة الجمع في خلايا معينه فالمعادلات متغيرات في اعمدة متغيره واود منكم شرح هذه الجزئيه A = .Cells(1, 1).End(xlDown).Offset(2, 0).Row .Range(Cells(A, 1), Cells(Rows.Count, 5)).EntireRow.Delete رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر مارس 19, 2012 مشاركة قام بنشر مارس 19, 2012 (معدل) السلام عليكم الشرح في المرفقات امل ان اكون وفقت في الشرح شرح.rar تم تعديل مارس 19, 2012 بواسطه alidroos رابط هذا التعليق شارك More sharing options...
mhrrd قام بنشر مارس 19, 2012 الكاتب مشاركة قام بنشر مارس 19, 2012 جزاك الله كل خيروبارك لك لو الصف المطاوب نسخه مكون من 115 عمود اين التغيير رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر مارس 19, 2012 مشاركة قام بنشر مارس 19, 2012 السلام عليكم الاخ الفاضل mhrrd ارجو منك ارفاق مثال لما تريد لم تتضح الصورة لدي رابط هذا التعليق شارك More sharing options...
mhrrd قام بنشر مارس 19, 2012 الكاتب مشاركة قام بنشر مارس 19, 2012 هذا هو الملف جزاك الله كل خير نقل بيانات.rar رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر مارس 19, 2012 مشاركة قام بنشر مارس 19, 2012 السلام عليكم جرب هذا التعديل Sub KH_Copy() On Error Resume Next Dim Last As Long Dim Count As Integer Count = 1 Count = Sheets("بيانات اساسية").Range("I2").Value With ActiveSheet Application.ScreenUpdating = False .Range(Cells(12, 1), Cells(Rows.Count, 150)).EntireRow.Delete Last = .Range("W" & .Rows.Count).End(xlUp).Row .Rows(Last).Copy .Rows(Last + 1).Resize(Count) Application.ScreenUpdating = True End With On Error GoTo 0 End Sub رابط هذا التعليق شارك More sharing options...
mhrrd قام بنشر مارس 19, 2012 الكاتب مشاركة قام بنشر مارس 19, 2012 الف الف شكر يابطل جزئية اخيره اذا اخترت 3 صفوف يظهر 4 هل ممكن عدد الصفوف يتساوى مع الخلية I2 رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر مارس 19, 2012 مشاركة قام بنشر مارس 19, 2012 إستبدل السطر الاخير الذي هو .Rows(Last).Copy .Rows(Last + 1).Resize(Count) بهذا .Rows(Last).Copy .Rows(Last + 1).Resize(Count - 1) رابط هذا التعليق شارك More sharing options...
أبو عبد الرحمن سعيد قام بنشر نوفمبر 10, 2013 مشاركة قام بنشر نوفمبر 10, 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.