ترحيل عدة بيانات بعدة شروط

[ليلى الهلالي]

السلام عليكم ورحمة الله وبركاته. أسعد الله أوقاتكم بكل خير.

أضع بين أيديكم استفساراتي للعمل المطلوب مني إنجازه حيث أني قد بحثت في طيات هذا المنتدى ووجدت الكثير من الإجابات التي لم استطع تطويعها في عملي لقلة فهمي في الأكواد.

المطلوب كالتالي:

لديَ حافظة دوام حضور وانصراف الموظفين وورقة عمل بالقوى العاملة للمنطقة التعليمية وأريد أن يتم ترحيل اسماء المعلمين والمعلمات من ورقة القوى العاملة إلى ورقة حافظة الدوام على أن يتم إنشاء ورقة لكل مدرسة وفيها جميع المعلمين بحسب الآني:

1)      ترحيل بيانات كل مدرسة في ورقة جديدة بحسب النموذج المرفق

2)      فرز بحسب العمل (إداري أولاً  من العمودين   /E4:E64  F4:F64) مثلا إذا كان الموظف اداري نكتب جوار اسمه عمله عمود( العمل الحالي ) فقط إذا كان اداري.

3)      فرز بحسب مادة التدريس اذا كان معلماً.

أدرجت أمثلة في حافظة الدوام.

 

 

 

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

 

 

شاكرة لكم مقدماً جهودكم المبذولة في هذا المنتدى الرائع الذي مهما غبت عنه أحن إليه ولو بنظرة إلى جديده.

 

 

الاستفسار في أوفيسنا.rar

تم تعديل أبريل 10, 2019 بواسطه ليلى الهلالي

[ليلى الهلالي]

السلام عليكم

 

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

 

[ليلى الهلالي]

السلام عليكم

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

أرجو مساعدتي في تطويعها في عملي. ولكم جزيل الشكر.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("N:N")) Is Nothing Then Exit Sub
        Select Case Target.Value
            Case "عائشة"
                Sheets("عائشة").Range("B7:c1900").Copy Sheets("القوى للمدارس").Range("n4:n1900")
            Case "الثلايا"
                Sheets("الثلايا").Range("B7:c1900").Copy Sheets("القوى للمدارس").Range("n4:n1900")
            Case "الزهراء"
                Sheets("الزهراء").Range("B7:c1900").Copy Sheets("القوى للمدارس ").Range("n4:n1900")
                  
        End Select
End Sub

[ليلى الهلالي]

 

السلام عليكم

حتى الآن لم أجد رداً من أحد وأعذروني فأنا أعلم مدى انشغالكم فأرجو أن أجد من يساعدني.

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

Option Explicit

Sub Copy_Method()
'Copy range to another workbook using Range.Copy Method

  'Copy range to another workbook
   Workbooks("برنامج القوى العاملة .xlsb").Worksheets("القوى للمدارس").Range("A4:i1900", "N4:n1900").Copy _
    Workbooks("حافظة دوام مدارس.xlsb").Worksheets("القوى العاملة").Range("A2:j1900")
        
  
  'IMPORTANT points to remember:
    'Both workbooks must be open.  We can use code to open/close workbooks.
    'Must reference correct file extensionin Workbooks property.
    'Workbooks do NOT have to be macro enabled.
    'Code can be stored in separate workbook (PMW).
    'Do not need to select or activate the workbooks first. Video on VBA Assumptions.
    
End Sub

Sub Copy_PasteSpecial_Method()

  'Copy range to clipboard
    Workbooks("برنامج القوى العاملة .xlsb").Worksheets("القوى للمدارس").Range("A4:i1900", "N4:n1900").Copy _
        
  'PasteSpecial to paste values, formulas, formats, etc.
   Workbooks("حافظة دوام مدارس.xlsb").Worksheets("القوى العاملة").Range ("A2:j1900")
.PasteSpecial Paste:=xlPasteValues
  
End Sub

Sub Copy_Values_Technique()

  'Set value of destination range to value of copy range
  Workbooks("برنامج القوى العاملة .xlsb").Worksheets("القوى للمدارس").Range("A4:i1900", "N4:n1900").Value = _
   Workbooks("حافظة دوام مدارس.xlsb").Worksheets("القوى العاملة").Range("A4:j1900").Value
    
End Sub


Sub Alternate_Workbook_Reference()

  'The ThisWorkbook property can be used if the code is in the same
  'workbook as the copy or destination range.  In this case the code
  'is in the destination workbook.
  Workbooks("برنامج القوى العاملة .xlsb").Worksheets("القوى للمدارس").Range("A4:i1900", "N4:n1900").Copy _
    Workbooks("حافظة دوام مدارس.xlsb").Worksheets("القوى العاملة").Range("A2:j1900")
    
    
  'Original reference
  Workbooks("برنامج القوى العاملة .xlsb").Worksheets("القوى للمدارس").Range("A4:i1900", "N4:n1900").Copy _
    Workbooks("حافظة دوام مدارس.xlsb").Worksheets("برنامج القوى العاملة .xlsb").Range("A2:j1900")

End Sub


Sub Sheet_Number_Reference()

  'Reference a sheet by its postion (index) number if the sheet name changes frequently.
  Workbooks("برنامج القوى العاملة .xlsb").Worksheets(1).Range("A4:i1900", "N4:n1900").Copy _
    ThisWorkbook.Worksheets("برنامج القوى العاملة .xlsb").Range("A2:j1900")

End Sub

وقد ساعدني كثيراً يتبقى لي الترحيل من شيت إلى شيت بشروط:

1)      إذا كان المدرس إداري اود أن يضع في(خانة العمل ) في حافظة الدوام (عمله: مثلاً أرشيف، مدير ، وكيل ، حاسوب ....وهكذا)

2)      أما إن كان معلماً فيضع في (خانة العمل) في حافزة الدوام (مادة التدريس : مثلا لغة عربية ، قرآن ، اسلامية ، رياضيات.....وهكذا)

3)      فرز العمل ليكون الإداري في أول الحافظة ثم يتم ترتيب المواد متتالية)

أريد أن نبدأ بحل هذه المسألة ثم ننتقل للبقية.

·         ملاحظة :

   اضطررت إلى تغيير أسماء المصنفات في الكود للتماشى مع الكود وتسهيل نقل اسم المصنف  بشكل أفضل

 

تم تعديل أبريل 13, 2019 بواسطه ليلى الهلالي

[توفيق عبد السلام]

انا مازلت باحاول شوفي ده ممكن تستفيدي منه

VBA_lessons.rar

[ليلى الهلالي]

السلام عليكم

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

مرة أخرى لك جزيل الشكر.

أستاذي الفاضل توفيق

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

 ولكن ما أريده ليس في الأكسس بل أريده في الأكسل.

[وائل يونس سلامي]

الأخت العزيزة ليلى 

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

و لكن بالمعادلات و ليس بالأكواد

أرفعة لك ربما يفيدك 

و جزاه الله خيرا لمن ساعد فيه 

وله كل التقدير 

 

‏‏عمال - ترحيل بالدوال.xlsx

[ليلى الهلالي]

السلام عليكم

أشكرك استاذي / وائل على الملف وسوف اطلع عليه بتمعن لتعلم المعادلات.

لك جزيل الشكر مرة أخرى.

وأتمنى أن أجد الحل بالأكودا لأن البرنامج الأصل مليء بالمعادلات ولا أريده أن يكون بطيئاً.

[وائل يونس سلامي]

اختي العزيزة و هذا نفس الملف 

و الحل بالأكواد 

أيضا بمجهود أساتذتنا الكبار في هذا المنتدى 

لهم كل تقديري 

 

عمال - ترحيل بالكود.xlsm

[ليلى الهلالي]

أستاذي الفاضل وائل:

أعتذر منك لكني لم أجد المعادلات؟؟

[وائل يونس سلامي]

اختي العزيزة 

الملف يعمل على إكسل 2019

و ان كان لديكِ نسخة أقدم 

سأرسل لك حل آخر على 2007

 

[وائل يونس سلامي]

قد يفيدك هذا الملف على 2007

 

ترحيل.xlsx

[ليلى الهلالي]

بارك الله فيك أستاذي على هذه الملفات وأشكرك لتعاونك.

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

وملف الترحيل الأخير سوف اطلع عليه أيضاً.

لك جزيل الشكر مرة أخرى وبارك الله فيك وجزاك الله خير الجزاء.

أعتذر منك الآن لأن الكهرباء لدينا سوف تنطفئ.

[وائل يونس سلامي]

أرجو من الله تعالى أن يفيدك 

و كله بجهود أساتذتي في هذا المنتدى الرائع

تحياتي