أكاديمية الصقر للتدريب

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


أهلا وسهلا بك زائرنا الكريم في أكاديمية الصقر للتدريب، لكي تتمكن من المشاركة ومشاهدة جميع أقسام المنتدى وكافة الميزات ، يجب عليك إنشاء حساب جديد بالتسجيل بالضغط هنا أو تسجيل الدخول اضغط هنا إذا كنت عضواً .





خطأ في كود الترحيل

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



28-04-2020 05:53 مساء
علي بطيخ سالم
عضو محترف
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 19-09-2018
رقم العضوية : 8086
المشاركات : 272
الجنس : ذكر
تاريخ الميلاد : 30-10-1982
الدعوات : 1
يتابعهم : 7
يتابعونه : 3
قوة السمعة : 1084
عدد الإجابات: 12
 offline 

أواجه خطأ في كود الترحيل وهو أن الخلايا العليا مدمجة ولا أدري ما المشكلة
 
 
  استمارة قبول الصف الأول الابتدائي جاهزة.xlsm   تحميل xlsm مرات التحميل :(4)
الحجم :(88.046) KB


28-04-2020 06:52 مساء
مشاهدة مشاركة منفردة [1]
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 33
قوة السمعة : 6607
عدد الإجابات: 67
 offline 
look/images/icons/i1.gif خطأ في كود الترحيل
ليست المرة الاولى التي اقول فيها ان الجدول في الاكسل يجب ان يكون مستقلاً عن اية بيانات اخرى
 يفصله عنها عامود او صف فارغ (ليس فقط في زمن كورونا بل في كل الاوقات)دون تدخل اي خلايا مدمجة
تم ادراج صف فارغ (الصف رقم 5) مخفي
الكود

Option Explicit

Sub transfer_data()
Dim Main As Worksheet
Dim m_rg As Range
Dim Arr(), itm
Set Main = Sheets("الرئيسية")
Arr = Array("مقبول", "مستبعد")
Set m_rg = Main.Range("a6").CurrentRegion
If Main.AutoFilterMode Then m_rg.AutoFilter
 For Each itm In Arr
  Sheets(itm).Range("A4:M100").Clear
  With m_rg
   .AutoFilter 13, itm
   .SpecialCells(12).Copy _
    Sheets(itm).Range("A4")
  End With
  Next
If Main.AutoFilterMode Then m_rg.AutoFilter
     
End Sub


الملف مرفق
 
 
 
  My_Flr.xlsm   تحميل xlsm مرات التحميل :(4)
الحجم :(68.793) KB


28-04-2020 07:05 مساء
مشاهدة مشاركة منفردة [2]
علي بطيخ سالم
عضو محترف
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 19-09-2018
رقم العضوية : 8086
المشاركات : 272
الجنس : ذكر
تاريخ الميلاد : 30-10-1982
الدعوات : 1
يتابعهم : 7
يتابعونه : 3
قوة السمعة : 1084
عدد الإجابات: 12
 offline 
look/images/icons/i1.gif خطأ في كود الترحيل
biggrin2 biggrin2 biggrin2 biggrin2 ليس بغريب على عملاق مثلك استاذنا تستحق كل الشكر والتقدير ...... لكن كيف يتم لصق البيانات كقيم حتى لا يحدث خلل في البيانات المرحلة
وهناك مشكلة أخرى وهي حساب الصيغ أريده أن يكون اوتوماتيك بدلاً من يدوي حتى تظهر النتيجة أمامي مباشرة فعندما حولتها من يدوي إلى اوتوماتيك اصبح يرحل البيانات بدون التواريخ

28-04-2020 07:34 مساء
مشاهدة مشاركة منفردة [3]
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 33
قوة السمعة : 6607
عدد الإجابات: 67
 offline 
look/images/icons/i1.gif خطأ في كود الترحيل
للصق القيم هذا  التعديل على الكود

Option Explicit

Sub transfer_data()
Dim Main As Worksheet
Dim m_rg As Range
Dim Arr(), itm
Set Main = Sheets("الرئيسية")
Arr = Array("مقبول", "مستبعد")
Set m_rg = Main.Range("a6").CurrentRegion
If Main.AutoFilterMode Then m_rg.AutoFilter
 For Each itm In Arr
  Sheets(itm).Range("A4:M1000").Clear
  With m_rg
   .AutoFilter 13, itm
   .SpecialCells(12).Copy

   Sheets(itm).Range("A4").PasteSpecial (8)
   Sheets(itm).Range("A4").PasteSpecial (14)
   Sheets(itm).Range("A4").PasteSpecial (12)
  End With
  Next
If Main.AutoFilterMode Then m_rg.AutoFilter
     End Sub





الكلمات الدلالية
الترحيل ،


 










اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 09:37 صباحا