اضافة المسح قبل نسخ الصفوف

[mhrrd]

السلام عليكم ورحمة الله

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

======

السلام عليكم

ماذا لو أردنا أن يضيف الكود عدد من الصفوف محدد بقيمة في خلية ما في صفحة أخرى غير التي نعمل عليها؟؟؟؟

استخدم مثلا الكود التالي:

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]

اختر العدد 10 لاضافة 10 صفوف ثم بعدها اختر العدد 3 لاضافة 3 صفوف

تجد الصفوف ال 10 موجودة ولا نريد ذلك

نريد المسح ثم اضافة عدد الصفوف الجديدة

[الـعيدروس]

السلام عليكم

السموحه توضيح اكثر

تم تعديل مارس 18, 2012 بواسطه alidroos

[cat101]

هذه اضافه فد تفي بالغرض

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

الخليه F9

KH_COPY.rar

[cat101]

ممكن يكون هناك مع الاخوة العلماء حلول افضل من حلي

[الـعيدروس]

تفضل

عرفت طلبك

من حل الأخ الفاضل 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]

تفضل

عرفت طلبك

من حل الأخ الفاضل 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]

هذه اضافه فد تفي بالغرض

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

الخليه F9

العلامة العيداروس

لم اوفق في جعل عدد الصفوف الاجمالي مساوي للعددد الكتوب في صفحة خبور

[الـعيدروس]

السلام عليكم

الاخ الفاضل 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(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]

الاستاذ الفاضل العيداروس

الكود الموجود بالمشاركة رقم 6

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

فالمعادلات متغيرات في اعمدة متغيره

واود منكم شرح هذه الجزئيه

   A = .Cells(1, 1).End(xlDown).Offset(2, 0).Row

		 .Range(Cells(A, 1), Cells(Rows.Count, 5)).EntireRow.Delete

[الـعيدروس]

السلام عليكم

الشرح في المرفقات

امل ان اكون وفقت في الشرح

شرح.rar

تم تعديل مارس 19, 2012 بواسطه alidroos

[mhrrd]

جزاك الله كل خيروبارك لك

لو الصف المطاوب نسخه مكون من 115 عمود

اين التغيير

[الـعيدروس]

السلام عليكم

الاخ الفاضل mhrrd

ارجو منك ارفاق مثال لما تريد

لم تتضح الصورة لدي

[mhrrd]

هذا هو الملف

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

نقل بيانات.rar

[الـعيدروس]

السلام عليكم

جرب هذا التعديل

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]

الف الف شكر يابطل

جزئية اخيره

اذا اخترت 3 صفوف يظهر 4

هل ممكن عدد الصفوف يتساوى مع الخلية

I2

[الـعيدروس]

إستبدل السطر الاخير

الذي هو

.Rows(Last).Copy .Rows(Last + 1).Resize(Count)

بهذا

.Rows(Last).Copy .Rows(Last + 1).Resize(Count - 1)

[أبو عبد الرحمن سعيد]

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