ابراهيم الحداد

السلام عليكم ورحمة الله جرب هذا حسب ما فهمت ايتام الجمعية الشرعية.rar

السلام عليكم ورحمة الله انسخ هذا الكود فى موديول جديد وخصص له زر Sub SecNim() Dim R As Integer, S As Integer Z = 0 Range("M7:M250").ClearContents For S = 7 To 13 For R = 7 To Range("K" & Rows.Count).End(xlUp).Row If Cells(R, "L") >= Cells(S, "E") And Cells(R, "L") <= Cells(S, "F") Then Z = Z + 1 Cells(R, "M") = Cells(S, "G") + Z - 1 End If Next Z = 0 Next End Sub

السلام عليكم ورحمة الله بارك الله فيك وجعله فى ميزان حسناتك

السلام عيكم ورحمة الله اكتب هذه المعادلة فى الخلية "B4" ثم اسحب نزولا =CONCATENATE(F4&E4&D4&C4)

السلام عليكم ورحمة الله تم التصحيح قوائم 2016.rar

السلام عليكم ورحمة الله تم المطلوب قوائم.rar

السلام عليكم ورحمة الله تفضل اخى الكريم قوائم.rar

السلام عليكم ورحمة الله تفضل قوائم 2016.rar

السلام عليكم ورحمة الله وكل عام وانتم بخير تفضل المده.rar

السلام عليكم ورحمة الله هذا آخر ما استطعت الوصول اليه تفضل المده.rar

السلام عليكم ورحمة الله تفضل المده.rar

السلام عليكم ورحمة الله اكتب هذه المعادلة فى الخلية("D4") ثم اسحب نزولا =COUNTIFS($B$2:$B$6;">="&LEFT(E4;9);$B$2:$B$6;"<="&MID(E4;16;8))

السلام عليكم ورحمة الله اكتب هذه المعادلة فى الخلية ("A1") ثم اسحب نزولا =IFERROR(VLOOKUP(A1;Sheet1!$D$1:$E$6;2;0);"")

السلام عليكم ورحمة الله تفضل اخى الكريم ترحيل.rar

السلام عليكم ورحمة الله استبدل الكود السابق بهذا الكود Sub Trans1() x = WorksheetFunction.Transpose(Range("A1:C1")) Range("A3:A5") = x Range("C3:C5") = x End Sub

السلام عليكم ورحمة الله انسخ هذا الكود والصقه فى حد الصفحة Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$D$7" Then Exit Sub Range("B11:C41").ClearContents For R = 3 To Sheet1.Range("B" & Rows.Count).End(xlUp).Row If Sheet1.Cells(R, "B") = Target Then Range("B11:B41") = WorksheetFunction.Transpose(Sheet1.Range("D" & R & ":AD" & R)) Range("C11:C41") = WorksheetFunction.Transpose(Sheet1.Range("D2:AD2")) End If Next For S = 11 To 41 If IsError(Cells(S, "B")) Or IsError(Cells(S, "C")) Then Cells(S, "B").ClearContents Cells(S, "C").ClearContents End If Next End Sub

السلام عليكم ورحمة الله ضع هذا الكود فى موديول جديد Sub Trans() Range("A3:A5") = WorksheetFunction.Transpose(Range("A1:C1")) End Sub

السلام عليكم ورحمة الله استبدل المعادلة السابقة بهذه المعادلة =IF(B1="";"";COUNTA($B$1:B1))

السلام عليكم ورحمة الله اكتب هذه المعادلة فى الخلية A1 =COUNTA($B$1:B1) ثم اسحب نزولا

السلام عليكم ورحمة الله استخدم دالة LEN فاذا كان الناتج اقل من 10 فهذا يعنى وجود سجل ارقامه اقل من 10

اخى الحبيب السلام عليكم ورحمة الله على حسب ما فهمت من طلبك حيث لايوجد شئ موثر يمكن اضافته تم اخفاء جدول الرواتب وتم حماية الخلايا الهامة والتى تحتوى معادلات ويخشى من التلاعب بها وتم ترك الخلايا التى يتكرر العمل عليها بدون حماية يمكنك ازالة الحماية فى اى لحظة فلا توجد كلمة سر وهذا هو الملف 2.rar

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

السلام عليكم ورحمة الله تفضل اخى الكريم 1.rar

السلام عليكم ورحمة الله تعديل بسيط ليعمل الكود Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column <> 4 Then Exit Sub Sheets("Sheet").[H1].Value = ActiveCell.Value End Sub

السلام عليكم ورحمة الله انسخ هذا الكود والصقه فى محرر الاكواد وخصص له زر Sub TrnsData() Application.ScreenUpdating = False For i = 1 To Sheets.Count For Each Sh In ThisWorkbook.Worksheets If Sh.Name <> "toc" Then Sh.Range("B10:G10").Copy For R = 2 To Range("A" & Rows.Count).End(xlUp).Row If Range("A" & R) = Sh.Name Then Range("F" & R).PasteSpecial xlPasteValues End If Next End If Application.CutCopyMode = False Next Next Application.ScreenUpdating = True End Sub