اذهب الي المحتوي
أوفيسنا

ترحيل من صفحة لأخرى عدى بيان واحد


إذهب إلى أفضل إجابة Solved by مختار حسين محمود,

الردود الموصى بها

المطلوب لو تكرمتم

ترحيل جميع  البيانات الموجودة بالشيت الأول  ( ادخال البيانات ) إلى الشيت الثاني (  السجل ) ولكن بشرط عدا التلاميذ المنقولون من المدرسة وهم بالعمود ( L )  المسمى التحويل  ، ويرحل المنقول إلى  المدرسة  - بمعنى يرحل جميع البيانات عدا التلاميذ المنقولون من المدرسة - والسلام عليكم ورحمة الله وبركاته

ترحيل بشرط.rar

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

  جرب الكود التالى  وهو فى المرفق

Option Explicit
Sub FilterDataCopyTo()
 
    Dim WS As Worksheet
    Dim myDate As Date
    
    Set WS = Sheets("ادخال بيانات")
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    With WS
        .AutoFilterMode = False
        .Range("A7:S7").AutoFilter Field:=12, Criteria1:="=محول إلى المدرسة", Operator:=xlOr, Criteria2:="="
        .UsedRange.Offset(1).SpecialCells(xlCellTypeVisible).Copy
    End With
   
    Sheets("السجل").Activate
    Range("B8").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("ادخال بيانات").Select
    Selection.AutoFilter
       
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox ("المهمة انتهت بنجاج")
End Sub

ترحيل ما عدا .rar

تم تعديل بواسطه مختار حسين محمود
  • Like 1
رابط هذا التعليق
شارك

 

  جرب الكود التالى  وهو فى المرفق

Option Explicit
Sub FilterDataCopyTo()
 
    Dim WS As Worksheet
    Dim myDate As Date
    
    Set WS = Sheets("ادخال بيانات")
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    With WS
        .AutoFilterMode = False
        .Range("A7:S7").AutoFilter Field:=12, Criteria1:="=محول إلى المدرسة", Operator:=xlOr, Criteria2:="="
        .UsedRange.Offset(1).SpecialCells(xlCellTypeVisible).Copy
    End With
   
    Sheets("السجل").Activate
    Range("B8").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("ادخال بيانات").Select
    Selection.AutoFilter
       
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox ("المهمة انتهت بنجاج")
End Sub

تمام أستاذ / مختار

ولكن تم الترحيل بداية من الصف 13 وليس 8

رابط هذا التعليق
شارك

  • أفضل إجابة

أخى الكريم  لم أجرب الكود كما ينبغى ولم أدقق فى النتائج  معذرة

Option Explicit
Sub FilterDataCopyTo()
 
    Dim WS As Worksheet
    Dim myDate As Date
    
    Set WS = Sheets("ادخال بيانات")
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    With WS
        .AutoFilterMode = False
        .Range("A7:S7").AutoFilter Field:=12, Criteria1:="=محول إلى المدرسة", Operator:=xlOr, Criteria2:="="
        .UsedRange.Offset(8).SpecialCells(xlCellTypeVisible).Copy
    End With
   
    Sheets("السجل").Activate
    Range("A8").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
   Sheets("ادخال بيانات").Select
    Selection.AutoFilter
       
   Application.CutCopyMode = False
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
   MsgBox ("المهمة انتهت بنجاج")
End Sub

تحياتى

تم تعديل بواسطه مختار حسين محمود
  • Like 1
رابط هذا التعليق
شارك

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

ملحوظة صغيرة  :تعديل أخر عشان محدش يقول علينا حاجة

حذف الاعلان  Dim myDate As Date  من الكود ليس له قيمة

فأنا كنت مستعجل امبارح قبل الفجر وفى نفس الوقت أريد انهاء الكود .

أرجو من الادارة حذف الاعلان من الكود  تحياتى للجميع

رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information