ارجو تصحيح كود الترحيل

[2saad]

اخواني أعضاء المنتدي الكرام بعد سلام الله عليكم ورحمة الله وبركاته

مرفق ملف به كود ترحيل من شيت control4  ( الأعمد الموضوع عليها اسهم ) الي شيت مناداة4

الكود به خطأ مش عارف اصححه

ارجو تصحيحه أو ماذا افعل لكي اصححهمصطفي.xlsb 

ولكم جزيل الشكر ووافر الاحترام

مصطفي.xlsb

[محمد هشام.]

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

جرب هدا 

Sub مناداة_4()

Dim wb As Workbook, wsData As Worksheet, wsDest As Worksheet
Dim arr As Variant, k As Variant, Col As Variant, r As Long
Set wb = ThisWorkbook: Set wsData = wb.Sheets("control4"): Set wsDest = wb.Sheets("مناداة4")

    
    arr = wsData.Range("C10:U" & wsData.Cells(Rows.Count, 6).End(xlUp).Row).Value2
    
    Application.ScreenUpdating = False
    
    wsDest.Range("l5:W1000").ClearContents
    
    Col = Array(12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23)
    
    For Each k In Array(1, 3, 4, 8, 10, 11, 14, 15, 16, 17, 18, 19)
        wsDest.Cells(5, Col(r)).Resize(UBound(arr, 1)).Value = Application.Index(arr, , k)
        r = r + 1
    Next k
   
Application.ScreenUpdating = True

End Sub

 

مصطفي - 2.xlsb

تم تعديل ديسمبر 14, 2023 بواسطه محمد هشام.

[2saad]

بارك الله فيك وأكثر الله من أمثالك

لي طلب عند حضرتك عايز اعرف المقصود من رقم 6 هل المقصود به العمود 6 في control4 اللي هو الاسم

    
    arr = wsData.Range("C10:U" & wsData.Cells(Rows.Count, 6).End(xlUp).Row).Value2

[محمد هشام.]

نعم يتم نسخ بيانات الأعمدة لغاية آخر قيمة على عمود الإسم  يمكنك تعديلها بما يناسبك

[2saad]

الله يفتح عليك وربنا يبارك فيك وفي أمثالك