استفسار لإضافة على الكود لترحيل مخصص

[م/ مغترب]

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

 طلب تعديل على كود الترحيل بحيث   لا يرحل كامل الاعمدة بل  اعمدة مخصصة

الكود يعمل تماما ويرحل كامل الصف بناءا على اسم الورقة + عمود Z

 

انا اريد ان ارحل  مثلا عمود A و c و F  بناءا على اسم الورقة + عمود Z

التعديل على ما هو ملون باللون الاحمر على ما اظن

نرجو المساعده بالتعديل

Dim S As String
Dim R As Integer, RR As Integer, c As Integer, CC As Integer
S = ActiveSheet.Name
Application.ScreenUpdating = False
Range("A10:Z500").ClearContents
With æÑÞÉ1
    For R = 2 To .Range("Z500").End(xlUp).Row
        
        If .Cells(R, "z") = S Then
            
            RR = RR + 1
            For c = 1 To 25
             
                CC = Choose(c, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25)

                          Cells(RR + 9, c) = .Cells(R, CC)
            Next c
        End If
    Next R
End With
Application.ScreenUpdating = True
End Sub

[م/ مغترب]

أرفقت ملف مثال تقريبي  فيه الشرح  لأخواننا  الكرام

 

 

وشكرا جزيلا

New Microsoft Excel Worksheet.zip

تم تعديل أغسطس 29, 2013 بواسطه م/ مغترب

[أبو محمد أشرف]

ممكن ترفق الملف أخي الحبيب