تحيل من اعمدة الى اعمدة يتم تحديدها واختيارها

[عطية23]

السلام عليكم

المطلوب داخل الملف ولكم جزيل الشكر

ترحيل من اعمدة معينة الى اعمدو يتم اختيارها.xlsm

[حسونة حسين]

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

تفضل

Sub Transfer_Non_Adjacent_Columns_Using_Arrays_By_Yasser_Khalil()
    Dim arr As Variant, i As Variant, cr As Variant, j As Long
    arr = Sheets("ورقة1").Range("A1").CurrentRegion.Value
    'الأعمدة المطلوب الترحيل إليها
    cr = Array(5, 8, 11, 15, 17, 20)
    'أرقام الأعمدة المطلوب ترحيلها
    For Each i In Array(1, 2, 3, 4, 5, 6)
        Sheets("ورقة2").Cells(1, cr(j)).Resize(UBound(arr, 1)).Value = Application.Index(arr, , i)
        j = j + 1
    Next i
End Sub

 

[عطية23]

جزيل الشكر للمبدع ابوالبراء ياسر خليل

ولاستاذنا الاستاذ حسونة حسين