ياسر خليل أبو البراء

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

وعليكم السلام ورحمة الله وبركاته اخي الكريم علي الحمد لله أن تم المطلوب على خير وأدى الغرض تقبل تحياتي

أخي العزيز حسام الحمد لله أن تم المطلوب على خير ، وأرجو أن تستفيد من الموضوعات المختلفة بالمنتدى ، فالمنتدى زاخر بالدرر وبالموضوعات القيمة ..كل ما عليك هو البحث والاجتهاد ، لتصل إلى مبتغاك وجزيت خيراً بمثل ما دعوت لي بالنسبة للتحفظ الذي ذكرته ، يقدم الأخوة في غالب الأحيان الشرح مع الحل المقدم وهذا في رأيي يسهل الكثير في تعلم الأعضاء المبتدئين ، فقط ركز مع الشروحات واسأل إذا لم يكن هناك نقطة واحدة ، علينا أن نتخطى مرحلة الأسماك الجاهزة إلى مرحلة اصطاد سمكتك بنفسك .. عشان السمك اللي هتصطاده بنفسك هيكون له طعم مختلف وعلى رأي المثل اللي بيقول : اللي ييجي بالسهل يروح بالسهل Come easy, go easy ..مش كدا ولا ايه يا عزيزي تقبل وافر تقديري واحترامي

أخي الكريم محمد أين الكود في الملف المرفق ربما نستطيع تقديم المساعدة بالإطلاع على الكود المقدم؟

أخي العزيز إبراهيم عدلي أهلاً بك في المنتدى ونورت بين إخوانك ..فأنت في بيتك الثاني في عائلة أوفيسنا التي لن تتكرر تقبل وافر تقديري واحترامي

أخي الكريم علي المصري إثراءً للموضوع وإضافة للحل الرائع المقدم من أخونا المتميز سليم إليك حل بالأكواد مع الشرح بالتفصيل ..لتستطيع التعديل بما يتناسب مع ملفك الأصلي Sub FilterMarks() 'تعريف المتغيرات Dim Counter As Integer, LR As Integer, I As Integer 'إلغاء تحديث الشاشة لتسريع الكود Application.ScreenUpdating = False 'بدء التعامل مع ورقة العمل النشطة With ActiveSheet 'مسح النطاق الذي ستوضع فيه النتائج .Range("J10:M1000").ClearContents 'حلقة تكرارية من 1 إلى 3 حسب عدد الأعمدة التي سيتم التعامل معها 'فالأعمدة التي سيتم التعامل معها وفلترتها هي العمود ف1 و ف2 و ف3 For Counter = 1 To 3 'إلغاء الفلترة في ورقة العمل قبل البدء في عمليات الفلترة .AutoFilterMode = False 'فلترة النطاق حسب الحقل رقم 2 في الحلقة الأولى ورقم 3 في الحلقة الثانية ورقم 4 في الحلقة الثالثة 'لنستطيع التعامل مع الثلاثة حقول ف1 و ف2 وف3 [Counter] وهنا استخدمنا المتغير المسمى 'وشرط الفلترة أكبر من الدرجة صفر وأقل من أو يساوي الدرجة 50 .Range("B2:E2").AutoFilter Field:=Counter + 1, Criteria1:=">0", Operator:=xlAnd, Criteria2:="<=50" 'نسخ النطاق الذي يحتوي الأسماء ويكون النسخ للخلايا الظاهرة فقط والتي تطابق الشروط .Range("B3:B" & Cells(Rows.Count, "B").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy 'لصق الأسماء في العمود المناسب حيث يكون اللصق في أول حلقة في العمود رقم 11 'وفي الحلقة الثانية في العمود رقم 12 وفي الحلقة الثالثة في العمود رقم 13 'اللصق يكون للقيم فقط بحيث نحافظ على التنسيقات الموجودة في نطاق النتائج .Cells(10, Counter + 10).PasteSpecial xlPasteValues 'تحديد أول خلية في ورقة العمل .Range("A1").Select 'الانتقال للحلقة التالية Next Counter 'إلغاء الفلترة في ورقة العمل .AutoFilterMode = False 'تحديد آخر صف في نطاق النتائج من خلال معرفة عدد صفوف النطاق الحالي مضافاً إليها 7 'يمثل الرقم 7 عدد الصفوف السابقة للنطاق الحالي أي نطاق النتائج LR = .Range("K9").CurrentRegion.Rows.Count + 7 'حلقة تكرارية من الصف رقم 10 إلى آخر صف في النطاق الحالي For I = 10 To LR 'الخلية في العمود العاشر تساوي قيمة العداد مطروح منه 9 ليعطي تسلسل للنتائج .Cells(I, "J") = I - 9 'الانتقال للحلقة التالية Next I 'انتهاء التعامل مع ورقة العمل الحالية End With 'إلغاء خاصية القص واللصق بعد عمليات النسخ Application.CutCopyMode = False 'إعادة تفعيل تحديث الشاشة Application.ScreenUpdating = True End Sub تقبل تحياتي Filter & AutoFilter Tutorial YasserKhalil.rar

أخي الكريم يرجى إرفاق ملفك والصورة التي بها المشكلة لعل أحد الأعضاء يستطيع تقديم المساعدة لك يرجى تغيير اسم الظهور للغة العربية

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

أخي الكريم أهلاً بك في المنتدى ونورت بين إخوانك المنتدى هنا ليس منتدى بل عائلة واحدة يجمعها الحب في الله يرجى تغيير اسم الظهور للغة العربية كما يرجى الإطلاع على موضوع التوجيهات في الموضوعات المثبتة في المنتدى تقبل تحياتي

أخي الحبيب ياسر العربي أنا بعز كل أهل الشرقية قلت ... وإنت كمان ليك معزة خاصة (وممكن نخليها خروف لو تحب أو بقرة) تقبل وافر تقديري وحبي واحترامي

الحمد لله الذي بنعمته تتم الصالحات بارك الله فيك أخي الحبيب إبراهيم .. وجزيت خيراً بمثل ما دعوت أنت لا تعرف مقدار محبتي لأهل الشرقية خصوصاً .. ففيها رجل من أحب الرجال إلى قلبي واسمه أ / رجب ويعمل في الإدارة (لا أعلم الإدارة التي يعمل بها) .. وهو من أحب الناس لقلبي تقبل تحياتي وأهل الشرقية جمعاء

أخي العزيز إبراهيم إليك إصدار آخر من الكود يقوم بتنسيق الخلايا كما تريد بدون اللجوء إلى التنسيق اليدوي ، كما يتم عمل فاصل للصفحات كما ترغب بعد كل 45 اسم بدون تدخل منك أيضاً كل ما عليك ان تنقر على زر الأمر وبعدها لا تنساني بدعوة بظهر الغيب Sub PopulateData() Dim Ws As Worksheet, Sh As Worksheet Dim I As Long, Col As Long, LR As Long, J As Long Set Ws = Sheet1: Set Sh = Sheet2 Col = 1 Application.ScreenUpdating = False With Sh .ResetAllPageBreaks With .Range("A1").CurrentRegion .Offset(1).Interior.Color = xlNone: .Offset(1).ClearContents: .Borders.LineStyle = xlNone End With End With With Ws For I = 2 To .Cells(Rows.Count, 1).End(xlUp).Row Step 45 .Cells(I, 1).Resize(45, 2).Copy Sh.Cells(Sh.Cells(Rows.Count, Col).End(xlUp).Row + 1, Col).PasteSpecial xlPasteValues If Col = 11 Then Col = 1 LR = Sh.Cells(Rows.Count, 1).End(xlUp).Row Sh.HPageBreaks.Add Before:=Sh.Cells(LR, 1).Offset(1, 0) Else Col = Col + 2 End If Next I End With With Sh With Sh.Range("A1").CurrentRegion .Borders.Weight = xlThin: .BorderAround Weight:=xlThin: .Range("A1").Select End With LR = Sh.Cells(Rows.Count, 1).End(xlUp).Row For J = 1 To 12 Step 2 .Range(.Cells(2, J), .Cells(LR, J)).Interior.Color = RGB(192, 192, 192) Next J End With Application.CutCopyMode = False Application.ScreenUpdating = True End Sub تقبل تحياتي Populate Data From One Column To Multiple Columns YasserKhalil V2.rar

أخي الفاضل إبراهيم جرب الكود التالي عله يفي بالغرض Sub PopulateData() Dim Ws As Worksheet, Sh As Worksheet Dim I As Long, Col As Long Set Ws = Sheet1: Set Sh = Sheet2 Col = 1 Application.ScreenUpdating = False Sh.Range("A1").CurrentRegion.Offset(1).ClearContents With Ws For I = 2 To .Cells(Rows.Count, 1).End(xlUp).Row Step 45 .Cells(I, 1).Resize(45, 2).Copy Sh.Cells(Sh.Cells(Rows.Count, Col).End(xlUp).Row + 1, Col).PasteSpecial xlPasteValues If Col = 11 Then Col = 1 Else Col = Col + 2 Next I End With Application.CutCopyMode = False Application.ScreenUpdating = True End Sub وإليك الملف المرفق ..غيرت فقط أسماء أوراق العمل ولن يؤثر على عمل الكود Populate Data From One Column To Multiple Columns YasserKhalil.rar

أخي العزيز إبراهيم بارك الله فيك على استجابتك لتغيير اسم الظهور للغة العربية ما زال الطلب غير واضح تماماً بالنسبة لي .. هل كل صفحة من الصفحات الموجودة مستقله عن غيرها أي أنك تريد أن تعامل كل صفة بناءً على عمود السري .. وفي الصفحة التالية يتم التعامل مع عمود السري الجديد ...أم أنك تريد نقل السري والدرجات من بقية الصفحات للصفحة الأولى .. بفضل إرفاق لشكل النتائج المتوقعة ...يكتفى بصفحتين لفهم الطلب بشكل جيد تقبل تحياتي

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

أخي الكريم مهند جرب المعادلة التالية =IFERROR(LEFT(A2,1)&". "&MID(A2,FIND(" ",A2)+1,LEN(A2)),"") إذا لم تعمل المعادلة غير الفاصلة العادية لفاصلة منقوطة تقبل تحياتي

أخي الكريم شيكسو يرجى تغيير اسم الظهور للغة العربية كما يرجى عند طرح موضوع وضع عنوان مناسب للموضوع كما فهمت من ملفك أو من ورقة العمل النشطة عند فتح المصنف جرب المعادلة بهذا الشكل إذا لم تعمل المعادلة معك قم باستبدال الفاصلة العادية إلى فاصلة منقوطة =SUMIF(H7:H71,"<>" & "",K7:K71) تقبل تحياتي

أخي الكريم يرجى تغيير اسم الظهور للغة العربية كما يرجى توضيح المطلوب أكثر .. اطلعت على الملف ووجدت أن هناك عمود للسري وعمود للدرجات في العمودين A و B ..هل تريد نسخ نفس السري ونفس الدرجات من هذين العمودين إلى بقية الأعمدة وحتى العمود L أم العمود M ..حيث أن آخر عمود هو عمود للسري؟؟؟ أم أنك تريد فقط نسخ عمود السري لبقية أعمدة السري؟؟

أخي الكريم .. يرجى تغيير اسم الظهور للغة العربية كما يرجى تغيير عنوان الموضوع ليصبح باللغة العربية .. كما يرجى إرفاق الملف الذي تقدمه كهدية لإخوانك ليستفيد منه الجميع تقبل تحياتي

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

أخي الكريم أحمد معاذ الله أن نتحامل على أحد ..فقط أردت توضيح وجهة نظري ، والكلام دائماً وأكرر ... الكلام غير موجه لشخص بعينه بل لجميع الأعضاء أحبك الله الذي أحببتني فيه وبارك الله فيك على كلماتك الطيبة ودعائك الطيب المبارك .. جمعنا الله وإياكم إخواني في الفردوس الأعلى من الجنة

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

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

أخي الكريم حسام أعتذر إن كان كلامي قد ضايقك لكن يتحتم علي توضيح النقاط الغامضة لتجد المساعدة أعتقد أنه يمكنك حل المشكلة ببساطة من خلال تسجيل ماكرو تقوم فيه بعمل تذييل لورقة العمل وإضافة ما شئت من نصوص أو غيرها .. ثم يمكنك استخدام الكود الذي تم تسجيله هذا كحل مبدئي يمكنك الاعتماد عليه .. أو يمكنك التعديل في هذا الكود ليحقق المطلوب .. وفيه شرح للأسطر المهمة فقط Sub InsertHeaderFooter() Dim Ws As Worksheet Application.ScreenUpdating = False For Each Ws In ThisWorkbook.Worksheets With Ws.PageSetup .LeftHeader = "" 'رأس الصفحة الأيسر.. .CenterHeader = "" 'رأس الصفحة الأوسط.. .RightHeader = "" 'رأس الصفحة الأيمن.. .LeftFooter = "YasserKhalil" 'تذييل الصفحة الأيسر .CenterFooter = "" 'تذييل الصفحة الأوسط .RightFooter = "" 'تذييل الصفحة الأيمن End With Next Ws Set Ws = Nothing Application.ScreenUpdating = True End Sub يقوم الكود بإدراج ما سيتم الكتابة بين أقواس التنصيص في المكان المخصص لذلك لكل أوراق العمل الموجودة تقبل تحياتي

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