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
mhrrd قام بنشر مارس 18, 2012 الكاتب قام بنشر مارس 18, 2012 اختر العدد 10 لاضافة 10 صفوف ثم بعدها اختر العدد 3 لاضافة 3 صفوف تجد الصفوف ال 10 موجودة ولا نريد ذلك نريد المسح ثم اضافة عدد الصفوف الجديدة
الـعيدروس قام بنشر مارس 18, 2012 قام بنشر مارس 18, 2012 (معدل) السلام عليكم السموحه توضيح اكثر تم تعديل مارس 18, 2012 بواسطه alidroos
cat101 قام بنشر مارس 18, 2012 قام بنشر مارس 18, 2012 هذه اضافه فد تفي بالغرض ولكن لم اوفق في جعل عدد الصفوف الاجمالي مساوي للعددد الكتوب في صفحة خبور الخليه F9 KH_COPY.rar
cat101 قام بنشر مارس 18, 2012 قام بنشر مارس 18, 2012 ممكن يكون هناك مع الاخوة العلماء حلول افضل من حلي
الـعيدروس قام بنشر مارس 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
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 السلام عليكم ورحمة الله اخي العلامه العيداروس تستأذن مني وانت اعلم مني حقا علامة فاضل
cat101 قام بنشر مارس 18, 2012 قام بنشر مارس 18, 2012 هذه اضافه فد تفي بالغرض ولكن لم اوفق في جعل عدد الصفوف الاجمالي مساوي للعددد الكتوب في صفحة خبور الخليه F9 العلامة العيداروس لم اوفق في جعل عدد الصفوف الاجمالي مساوي للعددد الكتوب في صفحة خبور
الـعيدروس قام بنشر مارس 18, 2012 قام بنشر مارس 18, 2012 السلام عليكم الاخ الفاضل cat101 حفظك الله كلنا نتعلم من بعض نحنو في بداية الطريق وفقك الله لما فيه الخير هل نتائج الكود مزبوطه ؟
الـعيدروس قام بنشر مارس 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
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
الـعيدروس قام بنشر مارس 19, 2012 قام بنشر مارس 19, 2012 (معدل) السلام عليكم الشرح في المرفقات امل ان اكون وفقت في الشرح شرح.rar تم تعديل مارس 19, 2012 بواسطه alidroos
mhrrd قام بنشر مارس 19, 2012 الكاتب قام بنشر مارس 19, 2012 جزاك الله كل خيروبارك لك لو الصف المطاوب نسخه مكون من 115 عمود اين التغيير
الـعيدروس قام بنشر مارس 19, 2012 قام بنشر مارس 19, 2012 السلام عليكم الاخ الفاضل mhrrd ارجو منك ارفاق مثال لما تريد لم تتضح الصورة لدي
mhrrd قام بنشر مارس 19, 2012 الكاتب قام بنشر مارس 19, 2012 هذا هو الملف جزاك الله كل خير نقل بيانات.rar
الـعيدروس قام بنشر مارس 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
mhrrd قام بنشر مارس 19, 2012 الكاتب قام بنشر مارس 19, 2012 الف الف شكر يابطل جزئية اخيره اذا اخترت 3 صفوف يظهر 4 هل ممكن عدد الصفوف يتساوى مع الخلية I2
الـعيدروس قام بنشر مارس 19, 2012 قام بنشر مارس 19, 2012 إستبدل السطر الاخير الذي هو .Rows(Last).Copy .Rows(Last + 1).Resize(Count) بهذا .Rows(Last).Copy .Rows(Last + 1).Resize(Count - 1)
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.