تعديل كود ترحيل

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

المطلوب
1- الترحيل يكون تلقائي بدون الضغط على الزر
2- هو الان ينسخ اخر خليه ويرحلها اريد ان ينسخ اخر 10 خلايا مع الاخذ في الاعتبار ان النطاق متغير مثلا الان 40 خليه قد يكون متغير الى 70 او اكثر
بمعنى ان لايحدد نظاق يذهب للخليه الاخير ثم يحسب اعلى منها 10 خلايا ويرحلها
مع الشكر

 

الملف والكود مرفق ترحيل.rar

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

للرفع

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

السلام عليكم

 

جرب هذا

وهو يعمل بالزر

Private Sub CommandButton1_Click()
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
    .Select
End With
End Sub

اذا اردته تلقائي حدد في اي حدث تريده

 

تحياتي

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

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

بخصوص التنفيذ التلقائي ماريده ان الخليه متغيرة القيم اريده يرحل مباشرة اي تعديل في القيم ويرحلها مباشره بدون الضغط على الزر ليرحل

ان امكن مع شكري وتقديري لشخصك الكريم

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

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

بخصوص التنفيذ التلقائي ماريده ان الخليه متغيرة القيم اريده يرحل مباشرة اي تعديل في القيم ويرحلها مباشره بدون الضغط على الزر ليرحل

ان امكن مع شكري وتقديري لشخصك الكريم

 

تقصد ان التغيير يجدث للقيم التي في العمود A

طيب

وكيف يتم التغيير هل يدويا او بمعادلة ؟؟

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

يتم تعبئة العمود a

عن طريق استيراد بيانات خارجية من ملف اخر اكسل

يتم استيراد البيانات تلقائيا مع فتح الملف عن طريق خصائص استيراد بيانات خارجية

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

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

يتم تعبئة العمود a

عن طريق استيراد بيانات خارجية من ملف اخر اكسل

يتم استيراد البيانات تلقائيا مع فتح الملف عن طريق خصائص استيراد بيانات خارجية

 

جرب هذا

Private Sub Worksheet_Calculate()
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

تحياتي

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

شكرا لوقتك تم التعديل وعمل بهذا الكود ويحدث مباشره

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

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

[عمرو المصري]

ارجو من سيادتكم أ / عبدالله باقشير ان تشرح لي كيفية ترحيل بيانات طلبة راسبين وناجحين في شيت اخر مع تحديد الشرح علي النطاقات