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

[2saad]

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

لي طلبين من فضلكم

1 - عايز اعرف الخطأ في كود الترحيل من شيت ( ملف وتحريري نصف العام صف رابع ) الي شيت (سجل)

ابتداء من b14

2- عايز كود يحدث البيانات اتوماتيك يعني عندما اغير بيانات في ( ملف وتحريري نصف العام صف رابع )  يتغير في شيت (سجل)

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

razan.xlsm

[محمد حسن المحمد]

السلام عليكم

أخي الكريم

يمكنك فعل ذلك بشكل آلي كلما غيرت في الشيت إلا أنه سيكون مرهقاً لك وخصوصاً حجم البيانات كبير وفق الكود ذاته تضعه في حدث ورقة البيانات ( ملف وتحريري نصف العام صف رابع) كما يلي:

Private Sub Worksheet_Change(ByVal Target As Range)
'متغيرات
    Dim arr     As Variant
    Dim i       As Variant
    Dim cr      As Variant
    Dim j       As Long
'اسم شيت المصدر واسم الخليه الاولى منه
    arr = Sheets("ملف وتحريري نصف العام صف رابع").Range("b14").CurrentRegion.Value
    
    'الأعمدة المطلوب الترحيل إليها
    cr = Array(2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 16, 17, 36, 45, 56, 65, 76, 85, 96, 105, 116, 125, 136, 145, 156, 165, 192, 193, 198, 199, 204, 205, 210, 211, 216, 217, 19, 20, 21, 28, 29, 30, 39, 40, 41, 48, 49, 50, 59, 60, 61, 68, 69, 70, 79, 80, 81, 88, 89, 90, 99, 100, 101, 108, 109, 110, 119, 120, 121, 128, 129, 130, 139, 140, 141, 148, 149, 150, 159, 160, 161, 168, 169, 170)
    
    'أرقام الأعمدة المطلوب ترحيلها
    For Each i In Array(2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 16, 17, 19, 20, 22, 23, 25, 26, 28, 29, 31, 32, 34, 35, 37, 38, 40, 109, 41, 110, 42, 111, 43, 112, 44, 113, 45, 46, 47, 77, 78, 79, 49, 50, 51, 81, 82, 83, 53, 54, 55, 85, 86, 87, 57, 58, 59, 89, 90, 91, 61, 62, 63, 93, 94, 95, 65, 66, 67, 97, 98, 99, 69, 70, 71, 101, 102, 103, 73, 74, 75, 105, 106, 107)
    
    'اسم شيت الهدف ورقم صف صفحة الهدف
        Sheets("سجل").Cells(14, cr(j)).Resize(UBound(arr, 1)).Value = Application.Index(arr, , i)
        j = j + 1
    Next i
End Sub

ولذلك الأفضل التعديل على الموديول لديك كما يلي:

Sub Test1()
'متغيرات
    Dim arr     As Variant
    Dim i       As Variant
    Dim cr      As Variant
    Dim j       As Long
'اسم شيت المصدر واسم الخليه الاولى منه
    arr = Sheets("ملف وتحريري نصف العام صف رابع").Range("b14").CurrentRegion.Value

    'الأعمدة المطلوب الترحيل إليها
    cr = Array(2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 16, 17, 36, 45, 56, 65, 76, 85, 96, 105, 116, 125, 136, 145, 156, 165, 192, 193, 198, 199, 204, 205, 210, 211, 216, 217, 19, 20, 21, 28, 29, 30, 39, 40, 41, 48, 49, 50, 59, 60, 61, 68, 69, 70, 79, 80, 81, 88, 89, 90, 99, 100, 101, 108, 109, 110, 119, 120, 121, 128, 129, 130, 139, 140, 141, 148, 149, 150, 159, 160, 161, 168, 169, 170)

    'أرقام الأعمدة المطلوب ترحيلها
    For Each i In Array(2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 16, 17, 19, 20, 22, 23, 25, 26, 28, 29, 31, 32, 34, 35, 37, 38, 40, 109, 41, 110, 42, 111, 43, 112, 44, 113, 45, 46, 47, 77, 78, 79, 49, 50, 51, 81, 82, 83, 53, 54, 55, 85, 86, 87, 57, 58, 59, 89, 90, 91, 61, 62, 63, 93, 94, 95, 65, 66, 67, 97, 98, 99, 69, 70, 71, 101, 102, 103, 73, 74, 75, 105, 106, 107)

    'اسم شيت الهدف ورقم صف صفحة الهدف
        Sheets("سجل").Cells(14, cr(j)).Resize(UBound(arr, 1)).Value = Application.Index(arr, , i)
        j = j + 1
    Next i
End Sub

والله أعلم

والسلام عليكم

[عبدللرحيم]

الأخ / 2saad

جرب غير اسماء الشيتات أتجليزى

 

[2saad]

اشكركم جميعا وكل عام وانتم طيبون