تعديل كود

[طالب مدرسة أوفيسنا]

هل يمكن اضاقة عمود اخر لهذا الكود

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LR As Long
LR = Cells(Rows.Count, "A").End(xlUp).Row - 9
If LR <= 0 Then LR = 1
With ورقة2
    .Range("H1").Resize(10, 1).Value = Cells(LR, "A").Resize(10, 1).Value
End With
End Sub

مثال

هو الان يقوم بالبحث في اخر خلية في العمود A ويحسب قبلها 9 خلايا ثم يرحلها للعمود H

المطلوب

يقوم بنفس العمليه للعمود B ويرحل للعمود I

وايضا نفس العملية للعمود C ويحلها للعمود J

 

مع الشكر

تم تعديل يوليو 2, 2014 بواسطه x8.

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

السلام عليكم

 

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

    .Range("I1").Resize(10, 1).Value = Cells(LR, "B").Resize(10, 1).Value
    .Range("J1").Resize(10, 1).Value = Cells(LR, "C").Resize(10, 1).Value

تحياتي

[طالب مدرسة أوفيسنا]

مشكور استاذ عبدالله

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

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

مشكور استاذ عبدالله

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

جرب هذا

Private Sub Worksheet_Change(ByVal Target As Range)
Dim LR As Long
LR = Cells(Rows.Count, "A").End(xlUp).Row
If Not Intersect(Target, Range("A1:C" & LR)) Is Nothing Then
    LR = LR - 9
    If LR <= 0 Then LR = 1
    Range("H1").Resize(10, 1).Value = Cells(LR, "A").Resize(10, 1).Value
    Range("I1").Resize(10, 1).Value = Cells(LR, "B").Resize(10, 1).Value
    Range("J1").Resize(10, 1).Value = Cells(LR, "C").Resize(10, 1).Value
End If
End Sub

[طالب مدرسة أوفيسنا]

الف شكر استاذي الفاضل