رجب جاويش

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

أخى الفاضل / أبو إيمان جزاك الله كل خير

أخى الفاضل / سليم جزاك الله كل خير

السلام عليكم أخى الفاضل / سليم تسلم ايديك على هذه الإبداعات ولاثراء الموضوع هذا كود آخر يعتمد على Array وبدون عمود مساعد Sub ragab() Dim i As Integer Dim LR As Integer Dim cl As Range Dim arr() As Variant '========================================= Set WF = Application.WorksheetFunction LR = Cells(Rows.Count, 1).End(xlUp).Row '========================================= For Each cl In Range("A1:A" & LR) If Not IsEmpty(cl) Then i = i + 1 ReDim Preserve arr(1 To i) arr(i) = cl End If Next Range("A:A").ClearContents Range("A1").Resize(i) = WF.Transpose(arr) Erase arr End Sub ازالة الفراغات.rar

أخى الفاضل / رامي جزاك الله كل خير على هذا الدعاء الطيب

السلام عليكم أخى الفاضل هذه بعض التعديلات أرجو أن تعجبك Sub نسخ() Set ws = Sheets("Sheet2") ws.UsedRange.Clear x = 4 LR = Cells(Rows.Count, 2).End(xlUp).Row Application.ScreenUpdating = False Range("b" & x & ":h" & LR).Copy With ws .Range("b" & x).PasteSpecial xlPasteValues .Range("b" & x & ":h" & LR).PasteSpecial xlPasteFormats End With Application.CutCopyMode = False Application.ScreenUpdating = True Set ws = Nothing End Sub

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

السلام عليكم أخى الفاضل شكرا جزيلا وجزاك الله كل خير

تفضل أخى Book555.rar

السلام عليكم أخى الفاضل / محمد فى الملف المرفق يوجد أكثر من قيمة فى العمود H أكبر من 159

السلام عليكم تفضل أخى مثال.rar

السلام عليكم أخى الفاضل / محمد واذا كانت القيمة فى العمود H أكبر من 159

السلام عليكم بعد اذن أستاذنا الفاضل المحترم / احمد زمان أخى الفاضل / أبو حنين جرب التعديل التالى Sub Insert2ColmnValue() Application.ScreenUpdating = False Columns("K:L").Select Selection.Copy Columns("M:M").Select Selection.Insert Shift:=xlToRight Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Range("M1").Select Application.ScreenUpdating = True End Sub ترقيهTIST.rar

السلام عليكم أخى الفاضل / صلاح برجاء مراجعة الرابط التالى http://www.officena.net/ib/index.php?showtopic=52549&hl=

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

أخى الفاضل / أبو هبه أعتقد أن هذه العمليه صعبه وربما تكون غير ممكنه والله أعلم

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

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

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

السلام عليكم تفضل أخى 1233.rar

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

أخى الحبيب / ابراهيم جزاك الله كل خير أخى الحبيب على هذه الكلمات الطيبة تقبل أرق تحياتى

السلام عليكم أخى الفاضل / وليد ماذا تقصد بجملة ( تظهر الفورم بدون الملف خالص )

أخى الحبيب / فضل سوف يتم تغيير العنوان ليناسب محتوى الموضوع

السلام عليكم أخى الحبيب / فضل تفض أخى Sub ragab() Dim cl As Range Dim i As Integer Dim x As Integer Dim LR As Integer Set Rng = Range("C2:C42") Application.ScreenUpdating = False Range("E3:V42").ClearContents For i = 6 To 22 Step 2 For Each cl In Rng x = Application.WorksheetFunction.CountIf(cl, "*" & Cells(2, i) & "*") If x >= 1 Then LR = Cells(Rows.Count, i).End(xlUp).Row + 1 Cells(LR, i) = cl.Offset(0, -2) Cells(LR, i - 1) = cl.Offset(0, -1) End If Next Next i Application.ScreenUpdating = True End Sub مساعدة بكود.rar