نقل عمودين في عمود واحد

[TQTHAMI]

السلام عليكم ورحمة الله  ...كيف انقل بيانات عمودين في عمود واحد ...مرفق مثال

نقل عمودين في عمود.xlsx

[lionheart]

Sub Test()
    Dim a, c As Long, r As Long
    With ActiveSheet
        r = 7
        a = .Range("B7").CurrentRegion.Offset(1).Value
        For c = LBound(a, 2) To UBound(a, 2)
            .Range("E" & r).Resize(UBound(a, 1)).Value = Application.Index(a, , c)
            r = r + UBound(a, 1) - 1
        Next c
    End With
End Sub

 

[TQTHAMI]

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

نقل عمودين 1في عمود.xlsm

[أ / محمد صالح]

يمكنك استعمال هذا الاجراء

Sub merge2cols()
rng1Count = Cells(Rows.Count, "B").End(xlUp).Row - 6
rng2Count = Cells(Rows.Count, "C").End(xlUp).Row - 6
lr = Cells(Rows.Count, "E").End(xlUp).Row + 1
Range("E" & lr & ":E" & rng1Count + lr - 1).Value = Range("B7:B" & Cells(Rows.Count, "B").End(xlUp).Row).Value
lr = Cells(Rows.Count, "E").End(xlUp).Row + 1
Range("E" & lr & ":E" & rng2Count + lr - 1).Value = Range("C7:C" & Cells(Rows.Count, "C").End(xlUp).Row).Value
End Sub

بالتوفيق

 

 

نقل عمودين في عمود.xlsb

[TQTHAMI]

اهلا استاذنا الكبير 

نفس المشكله لايظهر لي الا 16 اسم بينما المفترض يظهر لي 31 اسم

[أ / محمد صالح]

لا أدري إن كان الرد السابق يتعلق بمشاركتي أم غيرها

على العموم

في الملف المرفق في مشاركتي يوجد 4 اسماء في العمود 2 الذي هو b وكذلك 4 اسماء في العمود 3 والذي هو c

ويتم وضعهم في العمود e والذي رقمه 5 في نهاية المكتوب

ربما يكون الخطأ في التطبيق على ملف جديد 

[TQTHAMI]

مع وافر التحية شاهد المرفق موضح به كل شي

نقل عمودين 1في عمود.xlsm

[أ / محمد صالح]

كما أخبرت حضرتك سابقا الخطأ في التطبيق

الملف الأصلي العمودين B  و  c وصف البداية 7

في الملف الجديد العمودين c و  d وصف البداية 4

ورغم الاختلاف حضرتك لم تعدل الكود ليتناسب مع الأعمدة الجديدة والبدايات الجديدة

أول خطوة قبل نقل الكود هو فهمه

أو عرض الملف الأصلي ختى لا يلجأ الإنسان للتعديل أو نقل الكود بطريقة خطأ

بالتوفيق

 

[TQTHAMI]

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

اذا امكن تطبقها على المرفق الاخير

[أ / محمد صالح]

الهدف من الموقع هو تبادل الخبرات والتعلم 

وليس تقديم برامج جاهزة للغير 

عليكم بدراسة الكود 

وتغيير العمودين ورقم البداية وعدد الصفوف أعلى صف البداية 

بالتوفيق