حسين مامون

عليكم السلام 
جرب كما في الصورة

وعليكم السلام
انسخ الماكرو الى محرر الاكواد واحفظ الملف بصيغة xlsm
ثم جرب 
 
Sub copy_tous() Dim ws As Worksheet Dim Aws As Worksheet Dim lr Set ws = Sheets("Data") Set Aws = ActiveSheet lr = ws.Cells(Rows.Count, 1).End(3).Row ws.Range("a2:ar" & lr).Copy Aws.Range("a2") msgbox"تم النسخ بنجاح" End Sub  

اخي قلت ليست لي فكرة عن هذا يعني عن برمجتها

جواب على قد سؤالك هو هذا
Private Sub TextBox2_Change() If TextBox2 > 0 Then TextBox3.Value = Val(TextBox1) End If End Sub  

انظر المرفق
 
test2022.xlsx

ربما 
 
قرعة(3).xlsm

جرب هذا الماكرو 
فيه حلقة تكرارية تفحص التاريخ في العمود F  ويدرج COMMANT قبل عشرة ايام
 
Sub test() 'On Error Resume Next Dim lr Dim x Dim dt: dt = Date Dim dt2: dt2 = Format(DateAdd("d", -10, dt), "dd-mm-yyyy") With Sheets("نشاط") lr = .Cells(Rows.Count, "f").End(xlUp).Row .Range("f3:f" & lr).ClearComments For x = 3 To lr If Not IsDate(.Cells(x, "f")) = True Then GoTo 1 If CDate(Cells(x, "f")) = dt2 Then .Cells(x, "f").AddComment .Cells(x, "f").Comment.Visible = True .Cells(x, "f").Comment.Text Text:=":" & Chr(10) & "عشرة ايام متبقية " End If 1: Next x End With End Sub  

تفضل
ترحيل بيانات.xlsm

تفضل
Nouveau Feuille de calcul Microsoft Excel (2).xlsm

ربما هكذا احسن
Private Sub TextBox1_AfterUpdate() [d3] = Format(TextBox1, "dd-mm-yyyy") End Sub Private Sub TextBox1_Change() '[d3].Value = TextBox1.Value End Sub Private Sub TextBox2_AfterUpdate() [d3] = Format(TextBox2, "dd-mm-yyyy") End Sub Private Sub TextBox2_Change() '[d4].Value = TextBox2.Value End Sub  

بعد اذن الاستاذ Mohamed Hicham
انظر المرفق
Book1.xlsm

اعتذر 
انطر المرفق
FTable.xlsm

ربما تقصد هذا 
Sub TrData() Dim ws As Worksheet, Detl As Worksheet Dim LR, LR1 As Long, p As Long, A As Long, C As Range Set ws = Sheets("قاعدة البيانات") Set Detl = Sheets("بيان") LR = Detl.Range("H" & Rows.Count).End(3).Row For Each C In ws.Range("E2:E" & ws.Range("E" & Rows.Count).End(3).Row) A = WorksheetFunction.CountIf(Detl.Range("H2:H" & LR), C) If A = 0 Then Detl.Range("H" & LR + 1).Offset(p).Resize(12) = C Detl.Range("I" & LR + 1).Offset(p).Resize(12) = C.Offset(, 1) p = p + 12 End If Next End Sub  

جرب المرفق
فلتر.xlsm

وعليكم السلام ورحمة الله
اليك هذا الكود جربه 
يقوم بترحيل بشروط : اولها يفحص الخلايا في العمود 17 اذا كانت متطابقة مع اي شهر  (مسميات الصفحات)
تانيا : يفحص كود العميل في العمود b في الداتا و العمود b في شهر (الصفحة المطابقة للشرط الاول) اذا وجد الكود يمر الى التالي وغير ذلك يرحل
ملاحظة : اضف تتمة الكود حسب ما تريد ان يرحل
تحياتييييييييييييييييييييييييييي
Option Explicit Sub tarhil2() Dim sh As Worksheet Dim ws As Worksheet Set ws = Sheets("Accmove") Dim lr1, lr2, x Application.ScreenUpdating = False lr1 = ws.Cells(Rows.Count, 3).End(3).Row For Each sh In Sheets If sh.Name <> "Accmove" Then For x = 4 To lr1 lr2 = sh.Cells(Rows.Count, 2).End(3).Row If lr2 = 3 Then lr2 = lr2 + 1 If sh.Name = ws.Cells(x, 17).Text Then If Application.WorksheetFunction.CountIf(sh.Range("b5:b" & lr2), ws.Cells(x, 2)) > 0 Then GoTo 1 '=============== sh.Range("b" & lr2 + 1).Value = ws.Cells(x, 2) sh.Range("c" & lr2 + 1).Value = ws.Cells(x, 3) 'اضف ما تريد ان يرحل هنا كالسطرين اعلاه '=============== End If 1: Next x End If Next sh Application.ScreenUpdating = True End Sub  

وعليكم السلام ورحمة الله ...جرب المرفق
علامه صح اوخطأ.xlsm

جرب تغيير الشرط في الكومبوبوكسات كما في الصورة 

الحمد لله ان تم الامر على خير
تم عمل المطلوب  جرب المرفق
كشوفات الطلبة الرسمي 2022 - 1.xlsm

جرب المرفق
داتا-1 (2).xlsm

تفضل
اوفيسنا بحث معدل 3.xlsm

Sheets("ورقة").RAnge("a1").Select اذا كان اسم الشيت هو : ورقة3
نكتب في الكود: ("ورقة3")Sheets

جرب  ...عليك بربط الزر بالماكرو المسمى test ...كليك يمين على الزر ثم  Assing macro ثم كليك يسار على test ثم OK
نموذج بيانات الموردين.xlsm

استخدم الدالة COUNTIF
=COUNTIF(C3:C12;"ح") =COUNTIF(C3:C12;"غ")  

جرب المرفق ...كلمة المرور 123
اضهار شيت الاكسل بكلمة مرر.xls

تفضل جرب 
Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim x Dim lr Dim lrr On Error Resume Next lrr = Cells(Rows.Count, "c").End(3).Row If Not Intersect(Target, Range("c2:c" & lrr)) Is Nothing Then If Target = "" Then Exit Sub lr = Cells(Rows.Count, "e").End(3).Row For x = 4 To lr If Target.Offset(, -1).Text = Cells(x, "e").Text Then Cells(x, "f") = Val(Cells(x, "f")) + Val(Target): Exit For End If Next x End If End Sub  
مخزن 1992.xlsm