ترحيل بيانات

[مجاهد2013]

السلام عليكم

عندي في الملف المرفق في شيت data بيانات أساتذة أريد ترحيلها إلى شيت data2 بشرط ترتيب الأساتذة الرجال (H) في الخلايا الزرقاء و الأساتذة النساء(F) في الخلايا الوردية .

و كذلك ترحيل من data2 (بعد توزيع ساعات الحراسة ) يدويا إلى الجداول في الشيت الموالي حسب الجدول

و شكرا

الحراسة.rar

[سليم حاصبيا]

جرب هذا الماكرو

يوجد صفحة مساعدة مخفية باسم salim 

Option Explicit
  Sub filter_for_ME()
    With Application
     .ScreenUpdating = False
     .Calculation = xlCalculationManual
    End With
With Sheets("data2").Range("a7:D5000")
.ClearContents
.Interior.ColorIndex = 0
End With

Dim S_sh As Worksheet: Set S_sh = Sheets("data")
Dim T_sh As Worksheet: Set T_sh = Sheets("salim")
Dim My_Table As Range: Set My_Table = S_sh.Range("A11").CurrentRegion.Columns("A:F")
Dim r1%, m%: m = 7

T_sh.Cells.Clear
T_sh.Range("L1") = "الجنس": T_sh.Range("L2") = "H"
My_Table.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=T_sh.Range("L1:L2"), _
CopyToRange:=T_sh.Range("A1")
T_sh.Range("L1:l2").ClearContents
T_sh.Range("C:C,F:F").Delete
r1 = T_sh.Range("a1").CurrentRegion.Rows.Count
Sheets("Data2").Range("a" & m).Resize(r1 - 1, 4).Value = _
T_sh.Range("a2").Resize(r1 - 1, 4).Value
Sheets("Data2").Range("a" & m).Resize(r1 - 1, 4).Interior.ColorIndex = 33

m = m + r1

'====================================
T_sh.Cells.Clear
T_sh.Range("L1") = "الجنس": T_sh.Range("L2") = "F"
My_Table.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=T_sh.Range("L1:L2"), _
CopyToRange:=T_sh.Range("A1")
T_sh.Range("L1:l2").ClearContents
T_sh.Range("C:c,F:F").Delete
r1 = T_sh.Range("a1").CurrentRegion.Rows.Count
Sheets("Data2").Range("a" & m).Resize(r1 - 1, 4).Value = _
T_sh.Range("a2").Resize(r1 - 1, 4).Value
Sheets("Data2").Range("a" & m).Resize(r1 - 1, 4).Interior.ColorIndex = 40

T_sh.Cells.Clear
'===============================
With Application
     .ScreenUpdating = True
     .Calculation = xlCalculationAutomatic
 End With
End Sub

 الملف مرفق

salim_Book.xlsm

[مجاهد2013]

هل تقصد أستاذ سليم شيت باسم salim إن كان كذلك فأنا لم أجده للعلم أنا استعمل أوفيس 2007

ثانيا إذا وزعت قاعات الحراسة على الأساتذة مثلا من 01إلى 10بحيث يوجد 03 حراس بالقاعة يعني في الفترة الصباحية لليوم الأول أجد كل رقم من 01 إلى 10 يتكرر03 مرات و الحارس الاحتياطي أرمز له بحرف ح .كيف لي أن أرحل أسماء الأساتذة المعنيين بالحراسة (كل يوم و كل فترة ) إلى الجداول في الشيت 03