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

أخي الكريم أبو عبد الواجد ربما لم تجد استجابة في موضوعك نظراً لأن الخلايا المراد ترحيلها كثيرة جداً ... ولذا أهديك الكود فقط وأنت قم بالتعديل عليه بحيث تكمل بقية المصفوفة الكود يعتمد على عمل مصفوفة بالنطاقات المراد الترحيل منها ثم الترحيل دفعة واحدة وهذا الكود أسميه الكود السحري للترحيل وخصوصاً مع الخلايا المفردة والمتباعدة كما في ملفك حيث أن الخلايا المراد ترحيلها غير متجاورة ...وهذا ما يصعب المهمة السطر الذي ستقوم بالتعديل فيه هو السطر التالي myValues = Array(.Range("C4"), .Range("C5"), .Range("B27"), "", "", "", .Range("B28"), "", "", "", .Range("B29"), "", "", "", .Range("B30"), "", "", "", .Range("B31")) في هذا السطر لو لاحظت تكتب اسم الخلايا التي سيتم الترحيل منها وإذا كانت الخلية التي سيتم الترحيل إليها غير مستخدمة كما لاحظت في ملفك تترك مكانه فراغ .. حاول تفهم السطر عشان تعرف تكمله لأن وقتي ضيق للغاية وفي السطر التالي ستغير العدد 19 إلى آخر عمود حيث الرقم 19 يمثل العمود S وهو العمود الذي توقفت عنده ، ويمكنك التكملة على نفس المنوال .Range("A" & .Cells(Rows.Count, "A").End(xlUp).Row + 1).Resize(1, 19).Value = myValues حمل الكود من هنا تقبل تحياتي

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

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

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

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

أخي الحبيب أبو يوسف بارك الله فيك وجزاك الله كل خير على مبادرتك الطيبة ، ويعجبني أنك تجتهد حتى وإن فشلت ، فأنا أسعد بالمجتهد حتى ولو فشل آلاف المرات ... أخي الغالي سعد عابد أسئلة كثيرة .................. ولكن لعيون سعد (سعد سعد يحيا سعد) الفرق بين Value و Value2 لن أجيبك بشكل نظري بحت ولكن اعلم أن التاريخ يكتب في خلية ويظهر لك بشكل مختلف عن الشكل الأصلي الذي يقرأه الإكسيل اكتب أي تاريخ في الخلية A1 .... روح لمحرر الأكواد واضغط Ctrl + G عشان تفتح النافذة الفورية (يوجد موضوع لها في حلقات افتح الباب) ... في النافذة الفورية اكتب هذين السطرين (أنا قلت اكتب ولم أقل انسخ والصق ..بطل كسل) ?range("A1").Value ?range("A1").Value2 ولاحظ النتائج بنفسك السؤال الثاني هو الكلمة Redim وهي لإعادة تشكيل المصفوفة من حيث الأبعاد فوضعت هنا لكي أجعلها نفس أبعاد المصفوفة الأولى المسماة Arr .. السؤال الثالث لإضافة شروط .... الموضوع بسيط شايف السطر ده اللي فيه IF ..... If Arr(I, 1) >= startDate And Arr(I, 1) <= endDate Then قبل كلمة Then يمكن إضافة الشروط باستخدام كلمة AND ثم تضيف الشرط المطلوب .. ويمكن إضافة أكثر من شرط لا مشكلة في ذلك على الإطلاق أما بخصوص آلية الكود فهو يقوم بوضع قيم النطاق في مصفوفة ثم إنشاء مصفوفة أخرى لوضع النتائج المتوافقة مع الشروط الموضوعة وفي نهاية المطاف في آخر سطر يتم التعامل مع الإكسيل بوضع النتائج التي في المصفوفة Temp ووضعها في الخلية L10 أرجو أن تكون الإجابات قد أدت الغرض وأخيراً إليك شرح الكود في الموديول الثاني في الملف المرفق حمل الملف من هنا وتقبلوا وافر تقديري واحترامي

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

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

السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله إليكم موضوع ليس بجديد ولكنه جد مفيد ويطلب بشكل كبير ، فأحببت أن أفرد له موضوع ليسهل الوصول إليه ... أما وجود الأكواد في المشاركات الفرعية فلا يفيد الكثير من الأعضاء أقدم لكم كودين أحدهما يقوم بدمج الخلايا المتشابهة في نطاق ، والآخر يعكس عملية الدمج ويلغي الدمج .. عشان اللي يحضر عفريت يصرفه بفرض أن النطاق A1 إلى آخر خلية بها بيانات .. في هذا النطاق خلايا متشابهة في القيمة مثلاً الخلية A1 و A2 و A3 بها نفس القيمة وليكن حرف الـ "A" ..الكود التالي يقوم بعملية الدمج لهذه الخلايا Sub MergeSameCell() Dim Rng As Range, xCell As Range Dim xRows As Integer Set WorkRng = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row) Application.ScreenUpdating = False Application.DisplayAlerts = False xRows = WorkRng.Rows.Count For Each Rng In WorkRng.Columns For i = 1 To xRows - 1 For j = i + 1 To xRows If Rng.Cells(i, 1).Value <> Rng.Cells(j, 1).Value Then Exit For End If Next WorkRng.Parent.Range(Rng.Cells(i, 1), Rng.Cells(j - 1, 1)).Merge i = j - 1 Next Next Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub والكود التالي يعكس عملية الدمج ويلغي الدمج الذي تم في خلايا النطاق Sub UnMergeSameCell() Dim Rng As Range, xCell As Range Set WorkRng = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row) Application.ScreenUpdating = False Application.DisplayAlerts = False For Each Rng In WorkRng If Rng.MergeCells Then With Rng.MergeArea .UnMerge .Formula = Rng.Formula End With End If Next Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub أرجو أن يكون الموضوع ذات فائدة للجميع حمل الملف من هنا تقبلوا وافر تقديري واحترامي أخوكم ياسر خليل أبو البراء

وعليكم السلام ورحمة الله وبركاته أبي الحبيب أبو يوسف الحمد لله الذي هداك للتعلم وتعلي إخوانك .. بارك الله فيك وجزاك الله كل خير إضافة للموضوع وكودك هو الأفضل والأيسر والأسهل في التطبيق إليك حل بالأكواد لاستخراج البيانات بين تاريخين فقط بدون اية شروط أخرى ولكن باستخدام المصفوفات arrays كنوع من التدرب على استخدام المصفوفات Sub DataBetweenTwoDates() Dim Arr, Temp, I As Long, P As Long, startDate As Date, endDate As Date Arr = Range("B9").CurrentRegion.Offset(1).Value startDate = Range("C3").Value2: endDate = Range("C4").Value2 ReDim Temp(UBound(Arr, 1) - 1, UBound(Arr, 2) - 1) For I = LBound(Arr, 1) To UBound(Arr, 1) If Arr(I, 1) >= startDate And Arr(I, 1) <= endDate Then Temp(P, 0) = Arr(I, 1) Temp(P, 1) = Arr(I, 2) Temp(P, 2) = Arr(I, 3) Temp(P, 3) = Arr(I, 4) P = P + 1 End If Next I Range("L10").Resize(UBound(Temp, 1), UBound(Temp, 2) + 1).Value = Temp End Sub

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

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

السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله في أحد الموضوعات لأحد الأخوة الأعضاء كان قد طلب كيفية إرسال رسالة بريد إلكتروني (إيميل Email) باستخدام ملف إكسيل واليوم أقدم لكم الطريقة بالتفصيل من الألف إلى الياء ... وإن شاء الله تكون الطريقة ناجحة ومفيدة للجميع الخطوات اللازمة لعمل المطلوب : فتح حساب جديد على الـ Gmail إذا لم يكن لديك حساب وكيفية إنشاء حساب جديد مشروحة بالصور : نقوم بفتح برنامج الـ Outlook من قائمة Start ثم All Programs وندخل بيانات الحساب الذي أنشيء على الـ Gmail .. بهذا الشكل : وأخيراً وبعد عملية إنشاء الحساب وربط برنامج الـ Outlook بحساب الـ Gmail .. نقوم بفتح ملف إكسيل وفي العمود الأول ندخل الإيميلات المراد إرسال بريد إلكتروني لها .. وفي العمود الثاني نكتب اسم صاحب الايميل (اختياري) وفي العمود الثالث نكتب محتوى الرسالة المراد إرسالها .. وهذا هو الكود الذي سيقوم بمهمة إرسال رسائل البريد الالكتروني دفعة واحدة لكل الإيميلات المسجلة لديك .. ملحوظة مهمة جداً : من خلال محرر الأكواد يتم إضافة المكتبة التالية Microsoft Outlook Object Library من القائمة Tools ثم References .. Sub Mail_To_Friends() Dim SendTo As String Dim ToMSg As String Dim I As Integer For I = 2 To Cells(Rows.Count, 1).End(xlUp).Row SendTo = ThisWorkbook.Sheets(1).Cells(I, 1) If SendTo <> "" Then ToMSg = ThisWorkbook.Sheets(1).Cells(I, 3) Send_Mail SendTo, ToMSg End If Next I MsgBox "Done ...", 64 End Sub Sub Send_Mail(SendTo As String, ToMSg As String) Dim OutlookApp As Object Dim OutlookMail As Object Set OutlookApp = CreateObject("Outlook.Application") Set OutlookMail = OutlookApp.CreateItem(0) With OutlookMail .To = SendTo .CC = "" .BCC = "" .Subject = "Hello Officena" .Body = ToMSg .Send End With Set OutlookMail = Nothing Set OutlookApp = Nothing End Sub وأخيراً إليكم الملف المرفق مطبق فيه الكود وفيه نموذج لشكل ورقة العمل .. ويوجد زر أمر لعملية الإرسال .. وهذا هو الملف تقبلوا وافر تقديري واحترامي كان معكم أخوكم أبو البراء من منتدى أوفيسنا Send Mass Emails Through Outlook Using Excel VBA YasserKhalil Officena.rar

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

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

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

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

أخي الكريم خير الايمان هل تقصد استخدام برنامج Outlook لإرسال رسالة لبريد الكتروني؟

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

بارك الله فيك أخي المتميز أحمد الفلاحجي وجزيت خير الجزاء تقبل وافر تقديري واحترامي

أخي الكريم محمد عبد الناصر الطلب يحتاج لبعض التفاصيل الأخرى ماذا لو أنك قمت بمسح محتويات خلية تم إدخالها من قبل .. ما هو المنطق في عملية التسلسل في هذه الحالة؟ وسؤال يلح علي : لماذا تريد أن تسلسل في ورقتي عمل ..؟؟ هذا الأمر يحتاج لتفسير لربما نستفيد منه لأنني أراه غريباً وبالنسبة لسؤالك الأخير أن يبدأ التسلسل من 1460 .. أين هي البداية لأنها غير معروفة هل في ورقة 1 أم في ورقة 2 وكيف يفترض بالكود وضع التسلسل ومن المفترض أن الكود يقوم بعملية تنقيب عن الأرقام المسلسلة ثم يكمل عليها .. أم أنك تريد تحديد بداية التسلسل من خلال الكود نفسه وفي هذه الحالة ما هو المنطق في عملية التسلسل على البيانات المسجلة بالفعل؟ أرجو مزيد من التوضيح للمسألة .. تقبل تحياتي

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

بارك الله فيك أخي الغالي محمد أبو صهيب وجزيت خيراً على مشاركاتك القيمة الإيجابية

أخي الحبيب ياسر العربي يبدو أن جهازم مصاب بفيروس ..يرجى فحص الملفات قبل رفعها ..!

وجزيت خيراً أخي الحبيب جلال الأدهم بمثل ما دعوت لي مالي أراك كل فترة تظهر وتحتفي ... أين تفاعلك بالمنتدى ؟؟ ننتظر منك الكثير أخي الحبيب جلال