عبدالله باقشير

السلام عليكم جزاكم الله خيرا تقبلوا تحياتي وشكري

السلام عليكم جزاكم الله خيرا تقبلوا تحياتي وشكري

وعليكم السلام ورحمة الله وبركاته جزاكم الله خيرا تم اضافة النسخة في المشاركة السابقة اعلاه تحياتي

السلام عليكم جرب الكود التالي Sub kh_Start() Dim v, vv Dim Sh1 As Worksheet, Sh2 As Worksheet Dim Lr As Integer, i As Integer Set Sh1 = Sheets("عرض مبدئي") Set Sh2 = Sheets("العملاء") vv = Array("c11", "H12", "", "J14", "J16", "c12", "j18", "j20", "j22", "j44", "j48", "j32", "j38", "j36", "j34", "j40", "j522", "j50", "j54", "j56") Lr = Sh2.Cells(Rows.Count, "A").End(xlUp).Row + 1 For Each v In vv i = i + 1 If Not IsError(Sh1.Evaluate(v)) Then Sh2.Cells(Lr, i).Value = Sh1.Range(v).Value End If Next Set Sh1 = Nothing: Set Sh2 = Nothing End Sub المرفق 2003 aaaaaaaaaaaaa.rar تحياتي

السلام عليكم جزاكم الله خيرا تم تحميل المرفق في المشاركة الاولى

السلام عليكم استبدل هذا السطر Me.ListBox1.List = Range("A3:E" & iRow2).Value بهذا السطر Me.ListBox1.List = ws2.Range("A3:E" & iRow2).Value حيث انك لم تسند ورقة العمل بجنب نطاق الخلايا

السلام عليكم ضع اسم الكود الذي يفتح هذا الفورم في امر الزر من الفورم الاخر الذي تريده ان يفتح الفورم تحياتي

السلام عليكم فكر راقي جزاكم الله خيرا تقبلوا تحياتي وشكري

التهنئة بترقية الاخ سليم حاصبا الى عضو محترف

السلام عليكم جزاكم الله خيرا وكل عام وانتم بخير تقبلوا تحياتي وشكري

التهنئة بترقية الاخ محمد الريفي الى عضو محترف

السلام عليكم ورحمة الله وبركاته هذا من اصلكم الكريم جزاكم الله خيرا تقبلوا تحياتي وشكري

السلام عليكم استبدل هذا بالموجود Private Sub Update_Par() Dim PauseTime, Start, tm, tx Dim i As Long, iRnd As Long On Error GoTo kh_ex '---------------------------------- If Me.ListBox1.ListCount = Me.ComboBox3.Value Then If Me.ComboBox3.ListIndex Then If MsgBox("هل تريد مسح قائمة الانتقاء السابقة ؟ ", vbOKCancel + vbMsgBoxRtlReading, "تنبيه") = vbCancel Then GoTo kh_ex End If Me.ListBox1.Clear Set Obj = CreateObject("Scripting.Dictionary") End If '---------------------------------- kh_Enabled False PauseTime = kh_on_off() Start = Timer '---------------------------------- Do i = i + 1 tm = Timer - Start If i Mod (Me.ComboBox1.ListIndex + 1) * X = 0 Then 11 DoEvents iRnd = Int((Rnd * iCont) + 1) tx = mRng.Cells(iRnd, 1).Value If Obj.Exists(tx) Then GoTo 11 Me.LabelTxt = tx If PauseTime Then If tm >= PauseTime Then kh_Enabled True If tst Then Exit Do End If tm = Format(Abs(PauseTime - tm), "00") Me.LabelTime = "00:" & tm Loop '---------------------------------- Obj.Add tx, 1 With Me.ListBox1 .AddItem tx .ListIndex = .ListCount - 1 End With kh_ex: End Sub تحياتي

السلام عليكم حسب ما فهمت المرفق 2003 3 times.rar

ممكن تدخل العمود H في شرط الحدث If Not Intersect(Target, Range("H6:I" & Cells(Rows.Count, "I").Row)) Is Nothing Then

اليدوي يعني انك انت تقوم باجراء الحدث اما المعادلة حذثها Worksheet_Calculate هل بيانات العمود كلها معادلات ؟؟؟

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

هذا الكود للتغيير اليدوي هل تريد نقل المعادلة مع النسخ ؟؟ يعني اذا كانت معادلة ستنقل المعادلة وان كانت قيمة ستنقل قيمة

جزاكم الله خيرا وكل عام وانتم بخير تقبلوا تحياتي وشكري

استبدل هذا بدل الموجود Private Sub Worksheet_Change(ByVal Target As Range) Dim Cel As Range If Not Intersect(Target, Range("C6:C" & Cells(Rows.Count, "C").Row)) Is Nothing Then For Each Cel In Target.Cells Cells(Cel.Row, "G").Value = Cel.Value Next End If If Not Intersect(Target, Range("I6:I" & Cells(Rows.Count, "I").Row)) Is Nothing Then For Each Cel In Target.Cells Cells(Cel.Row, "L").Value = Cel.Value Next End If End Sub تحياتي

استخدم هذا الكود في موديل الورقة Private Sub Worksheet_Change(ByVal Target As Range) Dim Cel As Range If Not Intersect(Target, Range("C6:C" & Cells(Rows.Count, "C").Row)) Is Nothing Then For Each Cel In Target.Cells Cells(Cel.Row, "G").Value = Cel.Value Next End If End Sub تحياتي

السلام عليكم هذا سبب الخطأ في ملفك قم باضافتهما الى ملفك

وكل عام وانتم بخير تقبلوا تحياتي وشكري

السلام عليكم استبدل السطر With Range(Range("A5"), Range("A5").End(xlDown)).Resize(, 9).Borders(xlEdgeBottom) بهذا السطر With Cells(Cells(Rows.Count, "i").End(xlUp).Row, "a").Resize(1, 9).Borders(xlEdgeBottom) تحياتي

السلام عليكم جرب هذا Sub Macro1() With Range(Range("A5"), Range("A5").End(xlDown)).Resize(, 9).Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium End With End Sub تحياتي