اختصار كود

[الشيباني1]

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

code.rar

[سليم حاصبيا]

اليك ما يجب عمله

1-قم بتسمية كل النطاقات التي تريد نسخها بأي اسم فليكن myrange1

2 - قم بتسمية كل النطاقات التي تريد النسخ اليها  بأي اسم فليكن myrange2

3-نفذ هذا الكود

Sub Salim_copy()
 For i = 1 To Range("myrange1").Areas.Count
   Range("myrange1").Areas(i).Copy Range("myrange2").Areas(i).Cells(1, 1)
   Next
End Sub

 

 

 

[الشيباني1]

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

code.rar

[سليم حاصبيا]

اليك الكود اللازم لهذا الشيء

Sub My_rg()
Set my_rg1 = Range("L8:L12,M28:M35,L13:N13,l17,l19,l21,l23,l26,l30:l31,l33:l37,m37,l46,l38")
Set my_rg2 = Range("e8,h28,c13,e17,c19,c21,c23,e31,c33,g37")
  x = my_rg1.Areas.Count
  y = my_rg2.Areas.Count
   Z = Application.Min(x, y)
For i = 1 To Z
   my_rg1.Areas(i).Copy my_rg2.Areas(i)
Next
End Sub

 

[الشيباني1]

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

report2.rar

[سليم حاصبيا]

تم معالجة الامر

ملاحظة:عدد النطاقات المنسوخة لا يتساوى مع عدد النطاقات المنسوخ اليها 

لذلك انا وضعت العدد Z الذي يساوي الحد الادنى من عدد النطاقات المنسوخة والمنسوخ اليها

يرجى تحديد النطاقات بدقة اكثر من خلال الكود

 

report2salim.rar

[الشيباني1]

استاذنا القدير  اشكرك جدا وادامك الرحمن لنا اخا عزيزا