أ / محمد صالح

يمكنك استعمال هذا الكود للتصفية أولا ثم النسخ ثم الحذف
Sub copy_filtered_data() If Evaluate("=COUNTIF(I:I,""جاهز"")") > 0 Then Application.ScreenUpdating = 0 Dim lr1 As Long, lr2 As Long lr1 = Sheet1.Cells(Rows.Count, 1).End(3).Row lr2 = Sheet2.Cells(Rows.Count, 1).End(3).Row + 1 Sheet1.Range("$A$1:$I$" & lr1).AutoFilter Field:=9, Criteria1:="جاهز" Sheet1.Range("a2:i" & lr1).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheet2.Range("A" & lr2) Sheet1.Range("a2:i" & lr1).SpecialCells(xlCellTypeVisible).EntireRow.Delete Sheet1.Range("$A$1:$I$" & lr1).AutoFilter Application.ScreenUpdating = 1 MsgBox "done by mr-mas.com" Else MsgBox "لا يوجد صفوف جاهزة لترحيلها" End If End Sub وهذا ملفك بعد وضع الكود وتغيير الامتداد (لأن معظم الأوقات يكون صاحب الاستفسار لا يعرف كيفية التعامل مع أساسيات الأكواد)
بالتوفيق 
 
 
نسخ البيانات بعد الفلتر.xlsb

عليكم السلام
إذا قمت بتسجيل ماكرو ستحصل على الكود
وبقليل من التعديلات تجعل الكود متغيرا في صف الننهاية الذي رمزه LR
هذا هو الكود
Sub girlsfirst() Dim sh As Worksheet, lr As Long Set sh = ActiveWorkbook.Worksheets("sheet") lr = sh.Cells(Rows.Count, 3).End(3).Row With sh.Sort .SortFields.Clear .SortFields.Add2 Key:=Range("L10"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SortFields.Add2 Key:=Range("C10"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SetRange Range("B7:X" & lr) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End Sub Sub boysfirst() Dim sh As Worksheet, lr As Long Set sh = ActiveWorkbook.Worksheets("sheet") lr = sh.Cells(Rows.Count, 3).End(3).Row With sh.Sort .SortFields.Clear .SortFields.Add2 Key:=Range("L10"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal .SortFields.Add2 Key:=Range("C10"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SetRange Range("B7:X" & lr) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End Sub بالتوفيق

يمكنك استعمال هذا الكود في حدث الضغط على زر إدخال
Private Sub CommandButton1_Click() Sheets(1).Activate lrow = Range("e" & Rows.Count).End(xlUp).Row + 1 If WorksheetFunction.CountIfs(Range("D2:D" & lrow), ComboBox1.Value, Range("E2:E" & lrow), ComboBox2.Value) = 0 Then Range("d" & lrow).Value = ComboBox1.Value Range("E" & lrow).Value = ComboBox2.Value ComboBox1.Value = "" ComboBox2.Value = "" Else MsgBox "إدخال مكرر" End If End Sub بالتوفيق

ربما تكون نطاقات مسماة named ranges 
الموجودة في تبويب الصيغ formulas ضمن إدارة الأسماء name manager 
لو أرفقت الملف الذي به هذه المعادلة ربما نصل لليقين
بالتوفيق 

أخي الكريم 
يفضل ذكر كل التفاصيل المتاحة لديك حتي يتم الوصول للحل المطلوب بمنتهى السهولة وعلى مرة واحدة
لكن تجزئة المعطيات تؤدي إلى حلول غير مطلوبة
حسب فهمي للمطلوب أنك تريد
* وضع تسلسل يبدأ من الصف الثاني
* إلى آخر صف مكتوب فيه في العمود b وليس إلى 10
* والكود يتم تطبيقه من الأكسس على كائن الشيت النشط
يمكنك استعمال هذا الكود
Dim I As Integer For I = 2 To .range("b" & .rows.count).end(3).row .Range("A" & I).Value = I-1 Next I بالتوفيق 

عليكم السلام ورحمة الله وبركاته
* بالنسبة للمطلوب الأول
لا يمكن استخدام كالندر داخل الخلايا ممكن في يوزرفورم
ولكن يمكنك جعل تنسيق خلية التاريخ
dddd dd mmmm yyyy سيظهر اسم اليوم واسم الشهر مع التاريخ
ويمكنك الاستغناء عن عمود اليوم
* وبالنسبة لكتابة جميع تواريخ الشهر
يمكنك في الخلية B5 كتابة المعادلة التالية
=B4+1 مع نسخ المعادلة لأسفل
 
* وبالنسبة لموضوع منع التكرار يمكن استعمال التنسيق الشرطي وتلوين الصفين المكررين
وهذا ملفك بعد تنفيذ مقترحاتي
بالتوفيق
 
برنامج حجز قاعات 2021.xlsx

يمكنك استعمال هذا الكود في حدث عند تغيير التحديد
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column = 5 Or Target.Column = 7 Then Range("ad2").Value = Target.Value End If End Sub وهذا ملفك بعد إضافة الكود وتغيير الامتداد
بالتوفيق
Select.xlsb

هذا المطلوب لا يتم بالمعادلات
لابد من تدخل جراحي (vba)
يمكنك استعمال هذا الكود في حدث عند التغيير 
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row = 3 And Target.Column >= 1 And Target.Column <= 3 And Evaluate("=counta(a3:d3)") = 4 Then lr1 = Cells(Rows.Count, 1).End(3).Row + 1 lr1 = IIf(lr1 < 4, 4, lr1) lr2 = Cells(Rows.Count, 12).End(3).Row + 1 Range("a" & lr1 & ":d" & lr1).Value = Range("a3:d3").Value Range("l" & lr2 & ":o" & lr2).Value = Range("a3:d3").Value Range("a3:c3").ClearContents End If End Sub وهذا ملفك بعد إضافة الكود وتغيير الامتداد
555.xlsb

يمكنك استعمال هذه المعادلة في الخلية D6 مع نسخ المعادلة يمينا لنهاية الشهر
=IFERROR(IF(OR(COUNT($C5:C5)<1,D5-MAX($C5:C5)<0),"",D5-MAX($C5:C5)),"") ويمكن نسخ الخلية D6 إلى D8 لنسخ المعادلة
وهذا ملفك بعد التعديل
بالتوفيق 
كشف الفواتير للمركبات - بوقصي 9-2021 تجارب.xlsm

عليكم السلام و رحمة الله وبركاته 
الجزء الثاني من المطلوب غير منطقي
حيث سيظل الكود في حلقة من الأحداث لا تنتهي
فمثلا تم تغيير الدور الاول إلى الثالث
فيفترض من الكود أن يبحث عن موظف الدور الثالث ويضعه في الدور الأول
وحينها يتم استدعاء كود حدث التغيير لأن خلية الدور الثالث تغيرت في العمود E 
وساعتها يبدأ في البحث وهكدا
والحل في هذه المشكلة كتابة التغيير المطلوب في العمود G مثلا بالكود
ويتم كتابته مرة أخرى يدويا في العمود E
مع تعديل حدث التغيير إلى هذا الكود
Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("e8:e100")) Is Nothing Then Exit Sub lr = Range("h" & Rows.Count).End(xlUp).Row + 1 Cells(lr, "h") = Target.Offset(0, -2) Cells(lr, "i") = [k1] Cells(lr, "j") = Target.Value lr1 = Range("e" & Rows.Count).End(xlUp).Row If Target.Offset(0, 2) = "" Then For n = 8 To lr1 If n <> Target.Row And Cells(n, 5) = Target.Value And Cells(n, 4) = Target.Offset(0, -1) And Cells(n, 6) <> "راحة" Then Cells(n, 7) = [k1] Next n Else Target.Offset(0, 2) = "" End If End Sub بالتوفيق 

يمكنك استعمال هذه المعادلة في التنسيق الشرطي
=AND(A4<>"",A4<B4) وتقوم باختيار التعبئة أو اللون المرغوب ويتم تطبيقها على. العمود A مثلا أو أي خلايا منه
وإذا أردت تمييز الخلايا التي تساوي المتوقع أو أكبر يمكن استعمال هذه المعادلة
=AND(A4<>"",A4>=B4) بالتوفيق

يمكنك استعمال هذه الدالة المعرفة
Public Function MasIfs(ParamArray args() As Variant) As Variant Dim i As Integer Do Until CBool(args(i)) Or (i >= UBound(args)) i = i + 2 Loop If i < UBound(args) Then MasIfs = args(i + 1) End Function بالتوفيق 

هل تقصد نقل التركيز ؟ يعني المستطيل الغامق حول الخلية النشطة
أم فعلا تقصد سهم مؤشر الفارة بغض النظر عن الخلية المحددة
إذا كان المقصود الأول فيمكنك استعمال
Range("a1").select حيث a1 هي الخلية المراد الانتقال إليها

إن شاء اللّه يفيدك هذا المرفق
بيان العجز والزيادة.xlsx

حسب فهمي للمطلوب
إن شاء اللّه يكون هذا مطلوبك الثاني
Sub hideblank() For n = 2 To 151 Columns(n).Hidden = Iif(Cells(5, n) = "",True,False) Next n End Sub Private Sub Worksheet_Activate() hideblank End Sub بالتوفيق 

نظرا لوجود معادلة في العمود F ويكون ناتجها 0 في حالة عدم وجود أرقام
ينبغي تعديل معادلة العد في الخلية R4 إلى 
=COUNTIFS(B:B,Q4,F:F,">"&0) بالتوفيق 

أخي الكريم اعذرني طريقة تنظيم الملف لا تساعد في الوصول للمطلوب
تحتاج أولا إلى استعمال تنسيق الوقت 24 لضبط مواعيد الفترة الثانية وكل المواعيد بعد 12 ظهرا
لأنها مثلا تعتبر 12:45 أكبر من 1:00
وأقترح توفير عمودي موعد الحضور في الفترتين وكتابتهم في خليتين أعلى الجدول لأنهم ثابتان طوال الشهر
بعد الحصول على مدة التأخير الصحيحة يمكن عمل الشروط الخاصة بالخصم عليها فيما يخصص دقائق التأخير
وهذه معادلة مقترحة لحساب تأخير 1 وتأخير 2
بالتوفيق 
دوام ماهر الغيلي.xlsx

جرب حذف = التي قبل address
أو
إن شاء الله يفيدك هذا الموضوع المشابه 
بالتوفيق 
 

تفضل 
إن شاء اللّه يفيدك هذا المرفق
EXAMPLE.xlsb

هذا الخطأ يظهر نتيجة
إغلاق النموذج من زر الإغلاق والصواب حسب الكود كلك يمين على الزر الأيمن للساعة
ولتعديل ذلك حتى ينتهي تنفيذ الكود مع الغلق من زر الغلق
نقل آخر سطر من حدث UserForm_Initialize إلى حدث.UserForm_Activate
مع إضافة هذا الحدث الخاص بزر الإغلاق
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) OK = False Me.Hide End Sub بالتوفيق 

عليكم السلام و رحمة الله وبركاته 
كلك يمين على الحقل المراد تنسيقه
ثم اختيار Toggle Field Codes تبديل رموز الحقول
إضافة التنسيق قبل قوس الغلق ليصبح هكذا
{MERGEFIELD FieldName \#0.0} حيث FieldName اسم الحقل المراد تنسيقه
بالتوفيق

إذا تم تحويل الجدول إلى نطاق convert table to range من تبويب تصميم الجدول table design 
مع تغيير العمود E في هذا السطر 
Range("b2:h" & Cells(Rows.Count, "E").End(xlUp).Row).Copy إلى العمود B
ستحصل على ما تريد
بالتوفيق 

يمكنك الاستغناء عن باقي شيتات الشهور
حيث أن المعادلة تجلب بيانات جمبع الشهور 
بعد كتابة تاريخ بداية الشهر المطلوب (أو أي تاريخ منه) في الخلية A1
بالتوفيق 
جلب بيانات الشهور.xlsx

* يمكن بعمل حماية للخلايا بكلمة مرور
هكذا لا يمكن التعديل اليدوي إلا بكتابة كلمة المرور
* وبالنسبة لتعديل الخلايا المحمية بالكود
فيجب وضع سطر فك الحماية في بداية الإجراء 
ActiveSheet.UnProtect password:="mas" ويجب وضع سطر الحماية قبل نهاية الإجراء 
ActiveSheet.Protect password:="mas" حيث mas هي كلمة المرور المطلوبة
بالتوفيق 

المتغير k يزيد بمقدار 1 وهو المسئول عن وضع المواد في الأعمدة من 114 وما بعدها
لذا ينبغي تعديل هذه السطور
Cells(i, k ) = Cells(4, y - 2) k = k + 1 Else Cells(i, k ) = "" إلى
Cells(i, k + (y - 10) / 9) = Cells(4, y - 2) Else Cells(i, k + (y - 10) / 9) = "" لأن y بدايتها 10 والخطوات 9
ويوجد في الفصل الثاني  نفس الكود ولكن بداية y هي 16
بالتوفيق