نقل بيانات أعمدة محددة من ورقة إلى أخرى

[ناصرالمصرى]

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

لدى ورقتان الأولى " تسجيل بيانات" والأخرى "الرئيسية"

أريد نقل بيانات أعمدة  محددة  من ورقة " تسجيل البيانات" إلى " الرئيسية"

بنفس تنسيقات ورقة تسجيل البيانات كمصدر أساسى للبيانات على هذا النحو:-

نقل العمود A  الى العمود A

نقل الأعمدة B  و  C و D إلى الأعمدة M و N  و O

نقل العمود E  الى العمود X

نقل الأعمدة F  و  G  إلى الأعمدة Z و AA 

نقل الأعمدة H  و  I  إلى الأعمدة AE و AF 

نقل العمود J  الى العمود AJ

نقل الأعمدة K  و  L  إلى الأعمدة AU و AV

كيف يمكن تحقيق ذلك من خلال كود VBA  على أن يكون مرن وسريع

شكرا جزيلا مقدما وجزاكم الله خيرا

[عبدالله بشير عبدالله]

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

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

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

Sub TransferData()
    Dim srcSheet As Worksheet, destSheet As Worksheet
    Dim mapping As Variant
    Dim i As Long

    Set srcSheet = ThisWorkbook.Sheets("تسجيل البيانات")
    Set destSheet = ThisWorkbook.Sheets("الرئيسية")

    mapping = Array( _
        Array("A", "A"), _
        Array("B", "M"), _
        Array("C", "N"), _
        Array("D", "O"), _
        Array("E", "X"), _
        Array("F", "Z"), _
        Array("G", "AA"), _
        Array("H", "AE"), _
        Array("I", "AF"), _
        Array("J", "AJ"), _
        Array("K", "AU"), _
        Array("L", "AV"))

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    For i = LBound(mapping) To UBound(mapping)
        With destSheet
            .Columns(mapping(i)(1)).Clear
        End With
    Next i

    For i = LBound(mapping) To UBound(mapping)
        With srcSheet
            .Columns(mapping(i)(0)).Copy Destination:=destSheet.Columns(mapping(i)(1))
        End With
    Next i

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

   ' MsgBox "تم نقل البيانات !", vbInformation
End Sub

ملف

استدعاء اعمدة.xlsb

[أبو سجده]

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

بعد إذن اخى واستاذى الفاضل / عبد الله بشير

أعتقد ان الموضوع ليس بحاجة الى مرفق للعمل عليه فقد أوفيت

وهذة مشاركة بسيطة  للإفادة وبطريقة أخرى 

Sub test()
Dim i As Long, lr As Long, ocol
Dim ws1 As Worksheet, ws2 As Worksheet

ocol = Array(1, 13, 14, 15, 24, 26, 27, 31, 32, 36, 47, 48)

Set ws1 = Sheets("تسجيل بيانات")
Set ws2 = Sheets("الرئيسية")

Application.ScreenUpdating = False
With ws1
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    For i = 0 To 11
     .Cells(1, i + 1).Resize(lr, 1).Copy ws2.Cells(1, ocol(i))
    Next i
End With
Application.ScreenUpdating = False
End Sub

شكرا وجزاكم الله خيرا