رجب جاويش

تفضل أخى نسخ متعدد.rar

تفضل أخى Application.ScreenUpdating = False Set sh = Sheets("الشيكات المسددة") LR = Cells(Rows.Count, 1).End(xlUp).Row On Error Resume Next For i = 2 To LR If Cells(i, "E").Value <> "" And Cells(i, "E").Value = "نعم" Then Range(Cells(i, "A"), Cells(i, "D")).Copy sh.Range("A" & sh.Cells(Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial xlPasteValues Application.CutCopyMode = False Range(Cells(i, "A"), Cells(i, "E")).Delete Shift:=xlUp i = i - 1 End If Next i Application.ScreenUpdating = True MsgBox "تم الترحيل بنجاح" Set sh = Nothing End Sub شيكات مسددة1.rar

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

أخى الفاضل سيكون هذا السطر كالآتى : Range("A1").Resize(3) = Application.WorksheetFunction.Transpose(Split(arr, ","))

تفضل أخى نسخ متعدد.rar

تفضل أخى Sub ragab() Dim cl As Range Dim ws As Worksheet Application.ScreenUpdating = False On Error Resume Next y = ActiveWorkbook.Name For T = 1 To 3 x = ActiveWorkbook.Path & "\" & "Book" & T & ".xls" Workbooks.Open Filename:=x arr = arr & Sheets("ورقة2").Range("D7").Value & "," Workbooks("Book" & T).Save Activewindow.Close Next Range("A1").Resize(1, 3) = Split(arr, ",") Application.ScreenUpdating = True End Sub Desktop_2.rar

تفضل أخى تضع هذه المعادلة فى الخلية E3 ثم تسب لليسار =INDEX($A:$A;COLUMN(A1)) سحب خلية لليسار (2.rar

أخى الفاضل يفضل ارفاق ملف توضح به ما تريد

أخى الفاضل / أبو العقاب نعم يمكن التعديل كما تريد أرفق البيانات التى تريدها وان شاء الله يتم عمل المطلوب

أخى الفاضل جرب المرفق على الفورم الأول new insert.rar

أخى الفاضل / حمادة عمر اضافة رائعة من شخص رائع تسلم ايديك وجزاك الله كل خير على هذه الكلمات الطيبة

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

تفضل أخى Desktop.rar

أخى الحبيب / محمود نشاط ملحوظ وجهد متميز بارك الله فيك

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

أخى الفاضل /bboytiarti أهلا بك بين اخوانك اليك ملف مرفق مطبق عليه الدالة التى اقترحها الأستاذ الفاضل / عبد الله المجرب مجموع التكرار.rar

تفضل أخى Sub ragab() Dim cl As Range Dim arr() As Variant LR = [A1000].End(xlUp).Row T = 2: x = 2 '==================================== On Error Resume Next For Each cl In Range("A1:A" & LR) If IsDate(cl) Then Cells(1, T) = cl: T = T + 1 End If Next '==================================== For Each cl In Range("A2:A" & LR) If Not IsDate(cl) Then i = i + 1 ReDim Preserve arr(i) arr(i - 1) = cl Else Cells(2, x).Resize(i) = Application.WorksheetFunction.Transpose(arr) x = x + 1: Erase arr: i = 0 End If Next Cells(2, x).Resize(i) = Application.WorksheetFunction.Transpose(arr) End Sub نسخ متعدد.rar

تفضل أخى Sub ragab() Range("E5") = Application.WorksheetFunction.Sum(Range("D2:D20")) End Sub جمع.rar

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

تفضل أخى Book2.rar

أخى الفاضل /mazeno أخى الفاضل / عادل حسين جزاكم الله كل خير

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

بسم الله ما شاء الله بارك الله فيك أخى الحبيب أبو حنين كود رائع وجميل جدا

تفضل Book2.rar

تفضل أخى 11ع.rar