النسخ واللصق فى الاكسل

[osama k q]

 هل يمكن نسخ مجموعه خلايا متتاليه ولصقها فى خلايا اخرى بشكل متفرق كما هو موجود فى المثال المرفق 

ويتم عمل هذا الامر فى خطوه واحده 

افيدونا يا اهل الخبره فى الاكسل وشكرامثال.rar

مثال.rar

[ليلى الهلالي]

السلام عليكم

أخي الفاضل eng.osama.kh

ما الذي ترغب بعمله؟ هل هو ترحيل بيانات أم نسخ ولصق فقط أم ماذا حدد المطلوب ووضحه جيداً حتى يتم الإجابة على سؤالك.

[ياسر خليل أبو البراء]

جرب الكود التالي عله يفي بالغرض

Sub Test()
    Dim a As Variant
    Dim b As Variant
    Dim i As Long
    Dim x As Long
    
    a = Range("H12:H16").Value
    ReDim b(1 To UBound(a, 1) * 2, 1 To UBound(a, 2))
    
    For i = LBound(b, 1) To UBound(b, 1) Step 2
        x = x + 1
        b(i, 1) = a(x, 1)
    Next i
    
    Range("N12").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

 

أو كود أسهل من السابق

Sub Demo()
    Dim a As Variant
    
    a = Split(Join(Application.Transpose(Range("H12:H16")), ",,"), ",")
    Range("N12").Resize(UBound(a) + 1).Value = Application.Transpose(a)
End Sub

 

[osama k q]

اولا شكرا على الاهتمال 

المطلوب نسخ ولصق ولكن لصق فى خليه وترك خليه 

كما هوه موجود فى الملف المرفق

[ياسر خليل أبو البراء]

نعم أخي الأكواد المقدمة تقوم بذلك .. هل جربت الأكواد؟

[osama k q]

2 hours ago, morestudy said:

السلام عليكم

أخي الفاضل eng.osama.kh

ما الذي ترغب بعمله؟ هل هو ترحيل بيانات أم نسخ ولصق فقط أم ماذا حدد المطلوب ووضحه جيداً حتى يتم الإجابة على سؤالك.

حجربها وابلغك بالنتيجه انا شاكر على كل حال 

 

[osama k q]

 الاستاذ ياسر خليل

تم استخدام الكود وهوه يعمل كما كنت اريد 

ولكنه يعمل لمره واحده فقط 

لا استطيع تكرار الامر مره اخرى 

فهل يوجد تعديل فى الكود يمكن عمله لجعله يعمل بشكل مستمر

وشكرا

[ياسر خليل أبو البراء]

أعتقد أنك تقصد النطاق 

Range("H12:H16")

ستقوم بتغيير الرقم 16 إلى آخر رقم فيه بيانات أو .. استبدل هذا الجزء في الكود بهذا الجزء

Range("H12:H" & Cells(Rows.Count,"H").End(XlUp).Row)