طلب مساعدتي في تعديل كود vba نسخ ولصق

[ابو ياسر2]

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

اخواني ممكن مساعدتي في تعديل كود نسخ ولصق

 

Sub oddinho2z()

x = 5

Range("BU7:BU169,BV7:BV169").Copy

Range("DC7").Select

Do Until ActiveCell.Value = ""

    ActiveCell.Offset(, 1).Select

    x = x - 10

    If x = 0 Then Exit Sub

Loop

ActiveCell.Select

ActiveSheet.Paste

End Sub

 

هذا الكود يقوم بنسخ الاعمدة BU وBV  و لصقها من بعد عمود DC بترتيب متسلسل 

اريد ايضاء يقوم بنسخ الاعمدة H و I  ولصقها من بعد العمود KF بترتيب ايضاء متسلسل 

اتمنا مساعدتي

تم تعديل مارس 4, 2015 بواسطه etheer

[أبو إيمان]

الأخ الفاضل / etheer

إذا كان الأمر يتعلق بالنسخ واللصق فقط فهناك أبسط من ذلك ولا داعي لعمل حلقة تكرارية

Range("bu7:bv200").Copy
    ''ãßÇä äÓÎ ÇáÈíÇäÇÊ
        Range("dc7").Select
        ' ãßÇä áÕÞ ÇáÈíÇäÇÊ
    ActiveSheet.Paste
    Range("i7:h200").Copy
    Range("kf7").Select
    ActiveSheet.Paste
    Range("kf7").Select
    Application.CutCopyMode = False

[ابو ياسر2]

للاسف لا يعمل الكود بالشكل المطلوب 

انا اريد نفس الكود الاول الذي وضعتة و نفس عملة لكن مع اضافة انة ينسخ ويلصق العمود  H و I بعد العمود KF بتكرار مثل عمل الكود الاول

[خزاني]

حسب ما فهمت لك -----------  كود نسخ / لصق من ورقة واحدة إلى أخرى بشروطة

Private Sub CommandButton1_Click()
   Sheets("khezzani").Activate
Dim i As Integer
i = 10
Dim j As Integer
j = 10
Do While Cells(i, 10) <> ""
If Range("J" & i) = "khezzani1" Then
Range("B" & i & ":I" & i).Copy Sheets("khezzani1").Range("B" & j & ":I" & j)
j = j + 1
End If
i = i + 1
Loop
End Sub

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

جرب الكود بهذا الشكل

Sub oddinho2z()
    Dim X As Long, Y As Long
    X = 5: Y = 5
    Range("BU7:BU169,BV7:BV169").Copy
    Range("DC7").Select
    Do Until ActiveCell.Value = ""
        ActiveCell.Offset(, 1).Select
        X = X - 10
        If X = 0 Then GoTo 1: Exit Sub
    Loop
    ActiveCell.Select
    ActiveSheet.Paste
    
1    Range("H7:H169,I7:I169").Copy
    Range("KF7").Select
    Do Until ActiveCell.Value = ""
        ActiveCell.Offset(, 1).Select
        Y = Y - 10
        If Y = 0 Then Exit Sub
    Loop
    ActiveCell.Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
End Sub

[ابو ياسر2]

ألف شكر اخي  EMembers-3 وكل من حاول مساعدتي  

 

اخي EMembers-3  الكود يعمل بشكل المطلوب 

[أبو إيمان]

كود جميل أستاذنا ياسر

ومشكور أخر خزاني على فكرتك أيضا

 

الأخ السائل   EMembers-3     هو الاستاذ ياسر خليل والأسماء في المنتدى تظهر أعلى الصورة وليست أسفلها

 

لك مني وافر التحية

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

الأخ الحبيب PMembers-3 شكرا على المعلومة الخاصة بأسماء الأعضاء

الأخ الكريم Members-1 الحمد لله أن تم المطلوب

ولكن يرجى بعد ذلك إرفاق ملف أفضل .. ووضع الكود بين أقواس الكود <> تظهر في المحرر بهذا الشكل

تقبلوا تحياتي