أبو حنــــين

السلام عليكم يصبح الكود كالتالي في حالة مسح قيمة من العمود A Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A:A")) Is Nothing Then If Target.Offset(0, 1) = "" Or Not IsNumeric(Target.Offset(0, 1).Value) Then Cells(Target.Row, 2) = Now() Else End If End If If Target = "" Then Target.Offset(0, 1) = "" End Sub

السلام عليكم لديك مربعات النصوص مرقمة كالتالي TextBox1 TextBox2 TextBox4 TextBox5 TextBox13 TextBox14 TextBox15 TextBox16 اعد ترقيمها بهذا الشكل TextBox1 TextBox2 TextBox3 TextBox4 TextBox5 TextBox6 TextBox7 TextBox8

السلام عليكم هل تقصد بهذا الشكل طلب مساعدة في زر فورم.rar

السلام عليكم جرب الطريقة التالية ربط 1.rar

السلام عليكم هل بهذه الطريقة SMR1.rar

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

السلام عليكم كما ذكر اخي عبد الله الكود كان طويلا ، قمت بتغييره بحث وتعديل فى حالة تكرار الكود-2.rar

السلام عليكم حسب ما فهمت من الطلب جرب المرفق HAnine.rar

اخي سليم جزاكم الله خيرا

السلام عليكم ضع في الخلية F17 هذه الدالة ثم اسحبها الى الاسفل =SUMPRODUCT(($B$3:$B$10=B17)*($C$3:$C$10=C17)*($D$3:$D$10=D17)*($E$3:$E$10))

اخي ضاحي الغريب جزاكم الله خيرا على هذا العمل المتقن

السلام عليكم جرب هذه الكود Sub sCopy() Dim Lrr As Long, M As Integer Dim S Application.ScreenUpdating = False Lrr = Sheets("ورقة1").Cells(Rows.Count, "A").End(xlUp).Row For r = 2 To Lrr For Each S In ThisWorkbook.Sheets M = S.Cells(Rows.Count, "A").End(xlUp).Row + 1 If Trim(Sheets("ورقة1").Cells(r, 4)) = Trim(S.Name) Then Sheets("ورقة1").Range("A" & r).Resize(, 7).Copy With S .Range("A" & M).PasteSpecial xlPasteValues .Range("A2:G" & M).Borders.Value = 1 Application.CutCopyMode = False M = M + 1: End With End If Next Next Application.ScreenUpdating = True End Sub

السلام عليكم اخي زمزم رغم ان اخي الخالدي اجاب عن الطلب الاول لكنني اردت ان اجيب على نفس الطلب بحيث يمكن الترحيل كل يوم بدون تكرار بمعنى ان الترحيل يعتمد على اليوم مثلا قم بالترحيل ثم اذهب الى اي صفحة و غير التاريخ ستجد ان هذه الصفحة هي الوحيدة التي ترحل لها البيانات و هكذا *************************** بالنسبة للطلب الثاني ، عن نفسي لم افهم المطلوب ما الذي تقصده بحساب المتوسط ارجو ان توضح الطريقة بالتفصيل الممل ليسهل عليا و على الجميع المساعدة ملف zmzm الخاص بمنتيات 2اوفسينا.rar

السلام عليكم جرب ان تغير هذا السطر If Val1 = 1 Or Val2 = 1 Then بهذا السطر If Val1 = 1 And Val2 = 1 Then ملاحظة لم اجرب هذا جربه و اخبرني

أخي سليم جزاكم الله خيرا على هذا الكود

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

اضفت تنسيق لتلوين الخلايا 2 مدة حل المشكلة.rar

السىم عليكم هذه محاولة حسب فهمي للموضوع مع انني لم اجد بعض البيانات 1مدة حل المشكلة.rar

جزاكم الله خيرا

جرب هذا التعديل Private Sub CommandButton1_Click() Dim Lr As Long, Val1, Val2 With Sheets("ارشيف") Lr = .Cells(Rows.Count, "B").End(xlUp).Row + 1 Val1 = Application.WorksheetFunction.CountIf(.Range("B2:B" & Lr), B1) Val2 = Application.WorksheetFunction.CountIf(.Range("C2:C" & Lr), C1) If Val1 = 1 Or Val2 = 1 Then MsgBox "هذه القيمة مكررة", vbExclamation, "خطأ" Exit Sub End If .Cells(Lr, "B") = Me.Controls("B1").Value .Cells(Lr, "C") = Me.Controls("C1").Value .Cells(Lr, "D") = Me.Controls("D1").Value .Cells(Lr, "C") = Me.Controls("E1").Value .Cells(Lr, "D") = Me.Controls("F1").Value MsgBox ("تم النسخ للارشيف") End With End Sub

لا تنسى كتابة الاسم الصحيح لورقة العمل في السطر With Sheets("ارشيف")

جرب هذا التعديل على افتراض ان القيمة المعنية بعدم التكرار موجودة في العمود B Private Sub CommandButton1_Click() Dim Lr As Long With Sheets("ورقة2") Lr = .Cells(Rows.Count, "B").End(xlUp).Row + 1 If Application.WorksheetFunction.CountIf(.Range("B2:B" & Lr), B1) = 1 Then MsgBox "هذه القيمة مكررة", vbExclamation, "خطأ" Exit Sub End If .Cells(Lr, "B") = Me.Controls("B1").Value .Cells(Lr, "C") = Me.Controls("C1").Value .Cells(Lr, "D") = Me.Controls("D1").Value .Cells(Lr, "C") = Me.Controls("E1").Value .Cells(Lr, "D") = Me.Controls("F1").Value MsgBox ("تم النسخ للارشيف") End With End Sub

الملف بعد التعديل حضور.rar

السلام عليكم اخي و بعد اذن اخي بن عليه لتفادي هذه المشكلة يكفي وضع السطر التالي في بداية الكود Application.DisplayAlerts = False

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