أرجو تكملة هذا الكود البسيط

[رفيع سعد]

بسم الله الرحمن الرحيم

ألاخوة الافاضل سلام الله عليكم ورحمتة وبركاتة ارجو من حضراتكم تكملة هذا الكود  ولكم جزبل الشكر

[الصـقر]

اخى رفيع سعد اين هو الكود او الملف ؟؟

[رفيع سعد]

انا اسف ياجماعة بعد رفع الملف لم اجدة فى الموضوع وهحاول رفعة لانة تظهر لى رسالة تقول غير مسموح برفع هذا النوع من الملفات

[رفيع سعد]

1.rar

[الصـقر]

تفضل اخى الحبيب

ودا ما تم اضافته بالكود لو حابب تتعلم

Range("a3:A22").ClearContents
Range("c3:e22").ClearContents
Range("G3:h22").ClearContents

تم تحديد النطاقات التى يتم مسح محتوها ومن ثم الاعمده اللى بها معادلات سوف تكون فارغه 

تقبل تحياتى

1.zip

[رفيع سعد]

استاذى العزيز الصقر لك كل الشكروفعلا دة المطلوب الف شكر بس ممكن حاجة بسيطة كمان الغاء الهزة اثناء تنفيذ الكود

تم تعديل فبراير 1, 2015 بواسطه رفيع سعد

[الصـقر]

اخى الحبيب

اضف هذا السطر فى اول الكود

Application.ScreenUpdating = False

وقبل نهاية الكود اضف هذا السطر

Application.ScreenUpdating = True

تقبل تحياتى

[رفيع سعد]

استاذى العزيز الصقر بعد اضافة السطر اول الكود والسطر الاخير فعلا مبقاش فية اهتزاز لكن تم نسخ رؤس الاعمدة 

[الصـقر]

اخى الكريم

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

 

قم باضافه هذه السطور فى اول الكود 

Dim ws As WorksheetFunction

Set ws = WorksheetFunction
    If ws.CountA(Range("A3:A22")) < 1 Then MsgBox "لا يوجد بيانات للترحيل": Exit Sub

تقبل تحياتى

[رفيع سعد]

أستاذى الغالى الف شكر واسف اذا كنت تقلت عليك ولك منى الف شكر تم المطلوب بنجاح