(تمت الإجابة) كود نسخ نطاق في عدد من الصفحات في نفس المدي

[أيهاب ممدوح]

اخواني الاعزاء

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

مرفق

Book1.rar

[الـعيدروس]

لعله هكذا رغم انك الكود كبير

Sub ali_Copy()

On Error Resume Next

Application.ScreenUpdating = False

Application.EnableEvents = False

    Dim Rng1 As Range

    Dim Tgt  As Range

    Dim so   As Range

    Set Rng1 = Worksheets("سعر البيع").Range("c6:c1005")

    Set Tgt = Sheet17.Range("c6")

    Set so = Sheet16.Range("c6")

    Tgt.Offset(0).Resize(Rng1.Cells.Count).Value = Rng1.Value

    so.Offset(0).Resize(Rng1.Cells.Count).Value = Rng1.Value

End Sub

[الـعيدروس]

وهذا المرفق مع الزر حسب طلبك

copy_c.rar

[الـعيدروس]

وهكذا بيكون المدى غير محدد وانما من خليه C5 الى اخر خليه فيها بيانات

يقوم بنسخها الى المستودعات

Sub ali_Copy()

On Error Resume Next

Application.ScreenUpdating = False

Application.EnableEvents = False

    Dim Rng1 As Range

    Dim Tgt  As Range

    Dim so   As Range

    Dim LastRow As Long

    LastRow = Sheet2.Cells(Rows.Count, "c").End(xlUp).Row

    Set Rng1 = Sheet2.Range("c6:c" & LastRow)

    Set Tgt = Sheet17.Range("c6")

    Set so = Sheet16.Range("c6")

    Tgt.Resize(Rng1.Cells.Count).Value = Rng1.Value

    so.Resize(Rng1.Cells.Count).Value = Rng1.Value

End Sub

[أيهاب ممدوح]

اخي العزيز اود ان اشكرك علي المجهود الرائع

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

شكرا

[عبدالله المجرب]

اخي ايهاب سيصبح الكود هكذا

Option Explicit

Sub ali_Copy()

On Error Resume Next

Application.ScreenUpdating = False

Application.EnableEvents = False

	Dim Rng1   As Range, i As Integer

	Set Rng1 = Worksheets("سعر البيع").Range("c6:c1005")

For i = 2 To Sheets.Count

	   Sheets(i).Range("c6").Offset(0).Resize(Rng1.Cells.Count).Value = Rng1.Value

	Next i

End Sub

ومهما اضفت من شيتات سيتم الترحيل اليها

[أيهاب ممدوح]

اخي عبد الله

اود ان اشكرا

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

شكرااا

[عبدالله المجرب]

هنا ستحتاج الى تعريف متغيرات (DIM AS) كما ستحتاج الى ضبط (SET) لهذه المتغيرات

مثل

Dim Tgt  As Range

والضبط

Set Tgt = Sheet17.Range("c6")

وهنا نلاحظ بضبط وتعريف المتغيير Tgt بانه الخلية c6 في ورقة العمل Sheet17 ويمكنك استبدال Sheet17 باسم الشيت لتصبح هكذا

Set Tgt = Sheets("اسم الشيت").Range("c6")

[أيهاب ممدوح]

اخي ابو احمد هل تقصد هكذا

Sub ali_Copy()

On Error Resume Next

Application.ScreenUpdating = False

Application.EnableEvents = False

    Dim Rng1 As Range

    Dim Tgt  As Range

    Dim so   As Range

    Dim eh   As Range

    Set Rng1 = Worksheets("ÓÚÑ ÇáÈíÚ").Range("c6:c1005")

    Set Tgt = Sheet17.Range("c6")

    Set so = Sheet16.Range("c6")

    Set eh = Sheet18.Range("c6")

    Tgt.Offset(0).Resize(Rng1.Cells.Count).Value = Rng1.Value

    so.Offset(0).Resize(Rng1.Cells.Count).Value = Rng1.Value

    eh.Offset(0).Resize(Rng1.Cells.Count).Value = Rng1.Value

End Sub

[أيهاب ممدوح]

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

[الـعيدروس]

لاتنسى أسماء الاوراق

والكود لايقوم بالربط بتاتا

[عبدالله المجرب]

السلام عليكم

اخي ايهاب (الكود يعمل في الكلف الموجود به فقط )

[أيهاب ممدوح]

شكرا اساتذتي الكرام