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

أخي الحبيب أحمد بهجت إليك الملف التالي ..تم وضع الكود التالي في حدث المصنف Private Sub Workbook_Open() ThisWorkbook.Sheets("Sheet1").ScrollArea = "A1:N25" End Sub وبالتالي تم تحديد نطاق ليتم التنقل في هذا النطاق فقط Disable Scroll Bars.rar

أخي الفاضل صلاح إليك الملف التالي Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Cells.CountLarge > 1 Then Exit Sub If Target.Column = 5 Or Target.Column = 6 Or Target.Column = 7 Then ActiveWindow.Zoom = 120 Else ActiveWindow.Zoom = 100 End If End Sub Zoom If Columns Selected.rar

أخي الحبيب المعادلة من فوائدها أنك تحصل على نتائج محدثة دائماً .. فما الداعي لوضعها بالكود طالما أنها موجودة بالفعل !!؟؟ لم تصلني فكرتك بعد

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

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

جزيت خيراً أخي الحبيب محمد الريفي على مرورك العطر .. وتشريفك للموضوع تقبل ودي وحبي وتحياتي

جرب الملف التالي TextBox & ComboBox.rar

السلام عليكم ورحمة الله وبركاته إخواني الكرام ..أحبابي في الله **************** أقدم لكم درس جديد ، لعله أن يكون مفيد ، ويعجب الأخ الغالي عادل أبو زيد ، والأخ الحبيب أبو عيد ، واللي ميعجبوش الدرس يبعد بعيد .. درس اليوم عن استخدام دوال الإكسيل أو معظم الدوال الموجودة في الإكسيل في محرر الأكواد .. أترككم مع الفيديو .. ولا تنسوا لايكات على اليوتيوب ولايكات على الموضوع ولايكات للمنتدى ولايكات للأعضاء (الليلة ليلة اللايكات) ولا تنسوا قبل كل ذلك والأهم من ذلك ..دعواتكم بظهر الغيب إليكم رابط الفيديو أرجو أن ينال الموضوع إعجابكم وتستفيدوا منه .. أخوكم أبو البراء WorksheetFunction VBA.rar

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

الحمد لله الذي بنعمته تتم الصالحات .. ولا تنسي دعواتك للعبد الفقير إلى الله تقبل تحياتي

الأخت الفاضلة مريم تفضلي وجربي الملف المرفق (تم الاستعانة بعمود مساعد في ورقتي العمل ليتم إنجاز المهمة) ولا تنسي أن تختاري المشاركة التي تعجبك كأفضل إجابة Update Data.rar

جربي الملف التالي ولكن كما أخبرت ..يعتمد الكود على الرقم حتى يمكن للكود أن يجد الرقم ويقوم بالتعديل في المكان المناسب Update Data.rar

الاخت الفاضلة مريم أهلا بك في المنتدى بين إخوانك .. يفترض أن يكون هناك رقم مميز لكل شخص حتى يمكن أن يتم المطلوب .. لاحظت أن هناك رقم 1 مكرر مرتين

أخي خالد لم تتغير شكل الأيقونة في شريط المهام ..هذا أمر أمر آخر ..هل للأيقونات لابد أن توضع في المسار المذكور أم أنه يمكن تغيير مسار الأيقونات في الكود؟ لم أسأل عن تغيير اسم الأيقونة

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

إذا كان الأمر كما ذكرت أن عدد أوراق العمل كبير جداً فيمكن عكس الفكرة ..بمعنى وضع أوراق العمل التي لن يتم التعامل معها .. اطلع على الملف التالي .. لعله يكون المطلوب .سيتم التغاضي عن أوراق عمل محددة من خلال سطر من الكود أيضاً .. وما عدا تلك الأوراق سيتم التعامل معها ونسخ البيانات منها Sub CollectDataFromSheets() Dim SH As Worksheet Dim LR As Long Application.ScreenUpdating = False Sheets("شيت مجمع").Range("A3:H1000").ClearContents For Each SH In ThisWorkbook.Worksheets If SH.Name <> "بيان اجمالى " And SH.Name <> "بيان اجمالى شهرى" And SH.Name <> "الترحيل" And SH.Name <> "الصفحة الرئيسية" And SH.Name <> "شيت مجمع" And SH.Name <> "الناسخة" Then With SH .Activate LR = .Cells(300, 2).End(xlUp).Row .Range("B5:H" & LR).Copy With Sheets("شيت مجمع") .Range("B" & .Cells(Rows.Count, 2).End(xlUp).Row + 1).PasteSpecial xlPasteValues .Range("A" & .Cells(Rows.Count, 1).End(xlUp).Row + 1 & ":A" & .Cells(Rows.Count, 2).End(xlUp).Row) = SH.Name End With End With End If Next Sheets("شيت مجمع").Activate: Range("A1").Select Application.CutCopyMode = False Application.ScreenUpdating = True End Sub تقبل تحياتي Collect Data From Sheets V3.rar

وهذا ملف آخر يقوم بكود آخر يؤدي نفس الغرض Split Data Into Multiple Sheets Based On Column V2.rar

أخي الحبيب أحمد الشيخ ممكن هذا الموضوع يفيدك في طلبك http://www.officena.net/ib/index.php?showtopic=60294&hl= وعموما جرب الملف التالي عله يكون قريب من المطلوب وإن كنت أفضل أن يكون العمل من البداية على نور .. Split Data Into Multiple Sheets Based On Column.rar

ارفق الملف أخي الفاضل وراعي التوجيهات

المفروض المشاركة دي جاية متأخرة !!! ههههه ولا أنا اللي فاهم غلط تم التعديل والحمد لله ..كله بعون الله وتوفيقه تقبل تحياتي ..

أخي الحبيب محمد تفضل الملف المرفق ...كل ما عليك أن تضع أوراق العمل المطلوب جلب البيانات منها في مصفوفة بالترتيب الذي ترغب التعامل معه Sub CollectDataFromSheets() Dim MyArray As Variant, Item Dim LR As Long MyArray = Array("خط التعبئة والتغليف", "خط الاستلام والتجهيز", "1", "2", "3") Application.ScreenUpdating = False Sheets("شيت مجمع").Range("A3:H1000").ClearContents For Each Item In MyArray With Sheets(Item) .Activate LR = .Cells(300, 2).End(xlUp).Row .Range("B5:H" & LR).Copy With Sheets("شيت مجمع") .Range("B" & .Cells(Rows.Count, 2).End(xlUp).Row + 1).PasteSpecial xlPasteValues .Range("A" & .Cells(Rows.Count, 1).End(xlUp).Row + 1 & ":A" & .Cells(Rows.Count, 2).End(xlUp).Row) = Sheets(Item).Name End With End With Next Item Sheets("شيت مجمع").Activate: Range("A1").Select Application.CutCopyMode = False Application.ScreenUpdating = True End Sub ويتم ذلك من خلال السطر الرابع إليك الملف المرفق للتجربة ولا تنسى أن تحدد المشاركة التي تعجبك كأفضل إجابة ليظهر للأخوة الأعضاء أن الموضوع مجاب ، وعشان آخد نقطة (بعد التعب دا كله) تقبل تحياتي Collect Data From Sheets V2.rar

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

أخي الحبيب غسان هههههههه والله تعبت لك ..عديت لحد 18 سطر !! يا صبرك كان سهل تقوله في السطر ده ElseIf XX <> "123" Then ليه بنختار الطريق الصعب لما يكون فيه طريق سهل أنا مش بنتقدك أنا بس حبيت أمسي عليك تقبل مزحتي

أخي الفاضل يبدو أن الدالة دالة معرفة . قم بإرفاق ملف وتوضيح المطلوب كما ينبغي

أخي الكريم عبد الغني أعتقد أنه يجب التفكير بشكل آخر .. للحصول على النتيجة المرجوة بل وأفضل .. لما لا يكون العمل كما هو ..أي أنه يمكن للشخص الواحد أن يكون له سطر أو أكثر من سطر أو ربما عدة أسطر .. وفي ورقة عمل أخرى يتم عمل قائمة منسدلة بأسماء الأشخاص وبكود يمكن استدعاء البيانات الخاصة بهذا الشخص راجع هذا الموضوع لربما يفيدك http://www.officena.net/ib/index.php?showtopic=59889&hl=