أبو حنــــين

السلام عليكم أخي ربما الخطأ في تسمية الورقة تأكد من اسم الورقة التي تكتب بها البيانات و التي اسمها في هذا الكود With Sheet1 ربما الورقة ليس اسمها Sheet1

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

السلام عليكم العمود by لا يحتوي على كلمة ( راسب ) هناك فقط ( ناجح ) او ( غ ) او ( له دور ثاني )

و الله لقد اختلطت الامور ارجو ان تبين لي العمود المعني بالشرط انا اعتمدت على العمود BW هل هو صحيح ؟

السلام عليكم بعد اذن اخي عباد و كما ذكر سابقا كثرة الاوراق و معرفة الخلية التي يتحقق بها الشرط صعبت استيعاب الملف هذا تعديل للكود الذي وضعته انت و هو يقوم بترحيل الناجح و الراسب صف اول جرب هذا الكود Sub tarheel() 'gr1 Dim LR As Integer LR = [a10000].End(xlUp).Row Sheets("ناجحون صف اول اخر العام").Range("a14:ca1000").ClearContents Sheets("راسبون صف اول اخر العام").Range("a14:ca1000").ClearContents Application.ScreenUpdating = False With Sheets("رصد اول اخر العام") x = 14: y = 14: For i = 14 To LR If .Cells(i, 75) = "ناجح" And .Cells(i, 2) <> "" Then .Range("F" & i).Resize(1, 74).Copy Sheets("ناجحون صف اول اخر العام").Range("D" & x).PasteSpecial xlPasteValues Sheets("ناجحون صف اول اخر العام").Range("A" & x) = x - 13 Sheets("ناجحون صف اول اخر العام").Range("b" & x) = .Range("b" & x) Sheets("ناجحون صف اول اخر العام").Range("C" & x) = .Range("C" & x) x = x + 1 ElseIf (.Cells(i, 75) = "راسب" Or .Cells(i, 75) = "Û") And .Cells(i, 2) <> "" Then .Range("f" & i).Resize(1, 74).Copy Sheets("راسبون صف اول اخر العام").Range("d" & y).PasteSpecial xlPasteValues Sheets("راسبون صف اول اخر العام").Range("A" & y) = y - 13 Sheets("راسبون صف اول اخر العام").Range("b" & y) = .Range("b" & y) Sheets("راسبون صف اول اخر العام").Range("C" & y) = .Range("C" & y) y = y + 1 End If Next Application.CutCopyMode = False Application.ScreenUpdating = True End With End Sub

السلام عليكم هل بهذه الطريقة و هذا تعديل لمسح خلية الترتيب Private Sub Worksheet_Change(ByVal Target As Range) Dim LR As Integer LR = Cells(Rows.Count, 1).End(xlUp).Row On Error Resume Next If Target = "" Then Target.Offset(0, 1) = "" If Target.Column <> 1 Or Target = "" Then Exit Sub If Application.WorksheetFunction.CountIf(Range("A2:A" & LR), Target) > 1 Then MsgBox "هذا الرقم مكرر ", vbInformation, "اسم مكرر" Target = "": Target.Select Exit Sub Else Target.Offset(0, 1) = Val(Target.Offset(-1, 1)) + 1 End If End Sub Microsoft Excel.rar

بعد اذن اخي جمال من القائمة : بيانات --------> التحقق من الصحة ثم انظر الى الصورة المرفقة 1.rar

ارجو المعذرة من أخي عبد الله و اختي ام عبد الله

السلام عليكم ربما بهذه الصورة يكون المجال اوسع Private Sub Worksheet_Change(ByVal Target As Range) LR = Cells(Rows.Count, 2).End(xlUp).Row If Not Intersect(Target, Range("A1:B" & LR)) Is Nothing Then With Range("A1:B" & LR) .Sort .Columns(2), xlDescending End With End If End Sub

تصبح المعادلة بالشكل =IF(G15>=1000;G15*3%;IF(G15<=5000;G15*5%;IF(G15<=8000;G15*7%;IF(G15>=10000;G15*10%;))))

السلام عليكم استبدل السطر If Target.Column = 5 Then بالسطر التالي If Target.Column = 5 And Target.Row > 2 And Target.Row < 51 Then

اخي عباس زيادة الخير خيرين و الاثراء في هذه الحالات مطلوب جزاك الله خيرا

السلام عليكم مرفق 2003 كشف باسماء المشتركين.rar

السلام عليكم يمكن عمل ذلك بالدالة التالية لو كتبنا التاريخ مثلا في الخلية A1 تكتب مثلا في الخلية B1 الدالة التالية : =TEXT(A1;"ddd")

السلام عليكم تستطيع اضافة اكثر من 1000 ورقة في نفس الملف لكن المشكلة انه يصبح ثقيل جدا عند الغلق جرب الكود التالي Sub Add_Pages() For i = 1 To 1000 Set sh = Worksheets.Add sh.Name = i sh.Move After:=Sheets(Sheets.Count) Next End Sub

السلام عليكم هذه محاولة عسى انها تفي بالغرض Test1.rar

جزاكم الله خيرا على هذا الدعاء الطيب حفظكم الله و رعاكم

السلام عليكم قبل السطر الذي توقف عنده البرنامج ، أكتب السطر التالي On Error Resume Next

السلام عليكم جرب المرفق Book4442.rar

السلام عليكم من الواضح ان الخطأ في الجملة For i = 4 To Sheets("sheets1").ER بمعنى الاكسل لم يفهم الكلمة ER

عيدكم مبارك و كل عام و انتم بخير جزاكم الله خيرا

السلام عليكم كل عام و الأمة الإسلامية بخير و أمن و يمن و بركات أعاده الله علينا بالخير ان شاء الله

السلام عليكم جرب المرفق 1شاشة ادخال.rar

السلام عليكم هذا شرح مختصر للكود ' هذا السطر هو تنفيذ الكود في حالة فتح الفورم دون الضغط على اي زر Private Sub UserForm_Initialize() '********************************************************************************************** ' هذا السطر هو تحديد الورقة التي تحتوي على البيانات Set sh = Sheets("ورقة1") '********************************************************************************************** '********************************************************************************************** ' قمنا بتسميتها sh With sh '********************************************************************************************** '********************************************************************************************** ' هنا يتم تحديد آخر خلية من العمود الأول تحتوي على بيانات LsRow = .Cells(Rows.Count, "A").End(xlUp).Row '********************************************************************************************** On Error Resume Next '********************************************************************************************** ' يجب مسح اللستبوكس قبل ملئها ListBox1.Clear '********************************************************************************************** '********************************************************************************************** ' حلقة تكرار للخلايا التي تحتوي على بيانات For A = 2 To LsRow '********************************************************************************************** '********************************************************************************************** ' اضافة البيانات الموجودة في العمود الأول من ورقة البيانات الى العمود الأول في اللستبوكس ListBox1.AddItem .Cells(A, 1) '********************************************************************************************** '********************************************************************************************** ' اضافة البيانات الموجودة في العمود الثاني من ورقة البيانات الى العمود الثاني في اللستبوكس بتنسيق التاريخ ListBox1.List(C, 1) = Format(.Cells(A, 2), "dd-mm-yyyy") '********************************************************************************************** '********************************************************************************************** ' اضافة البيانات الموجودة في العمود الثالث من ورقة البيانات الى العمود الثالث في اللستبوكس ListBox1.List(C, 2) = .Cells(A, 3) '********************************************************************************************** '********************************************************************************************** ' لكي تنتقل الكتابة من الصف الاول في اللستبوكس الى الصف الذي يليه C = C + 1 '********************************************************************************************** Next '********************************************************************************************** ' حلقة تكرار لحساب عد الصفوف في اللستبوكس For j = 0 To ListBox1.ListCount - 1 '********************************************************************************************** '********************************************************************************************** 'جمع القيم الموجودة في العمود الثالث في اللستبوكس و وضعها في مربع النص TextBox4 = Val(TextBox4) + Val(ListBox1.Column(2, j)) '********************************************************************************************** Next On Error Resume Next '********************************************************************************************** ' الكود التالي خاص بتعبئة الكمبوبكس دون فراغات و دون تكرار الأسماء Dim MyValue As Collection, Cl As Range Set MyValue = New Collection For Each Cl In .Range("a2:a" & LsRow) MyValue.Add Cl.Value, Cl.Text Next Cl For i = 1 To MyValue.Count Me.ComboBox1.AddItem MyValue(i) Next i End With '********************************************************************************************** End Sub

جزاكم الله خيرا أخي عادل ابو زيد و لا تنسونا من صالح دعائكم