طارق محمود

السلام عليكم المرفق به يتم تكوين أوتوماتيكي لورقة المصرف إن لم تكن موجودة من قبل لايتم ترحيل البيان إن كان مقابل له كلمة (تم الترحيل) بالعمود AB يمكنك تفريغ جميع ورقات المصارف بالضعط علي الزر الأزرق يمكنك تحديث أسماء المجالات بعد حذف أو إضافة فروع للمصارف بالضعط علي الزر الأصفر (إعادة تسمية المجالات ) يتم كتابة كلمة (تم الترحيل) بالعمود AB مقابل كل بيان تم ترحيله يعطيك رسالة بالبيانات التي لم يتم ترحيلها لأنها مرحلة من قبل (أي أن مقابلها كلمة "تم الترحيل" بالعمود AB) وضعت بيانات افتراضية (الملونة) وتعمدت تكرار بعض الفروع للتأكد فقط مثل (التجاري-بن عاشور) ، (الصحاري-الزاوية) تفضل المرفق دليل المرتبا3.rar

السلام عليكم أين الملف الذي به الناححين والراسبين حتي أغير الكود عليه ؟؟

السلام عليكم أخي العزيز أولا أنا سعيد جدا أنك تسأل ، فهذا يعني أنك ستنضم قريبا إلي فريق العمل أقصد بـ LR السطر الأخير Last Row لاحظ أن ذلك الأمر قبل تنفيذ الفلتر وأقصد بـ NR السطر الأخير أيضا ولكن بعد تنفيذ الفلتر New Row

السلام عليكم أخي العزيز عذرا فلم تصل الفكرة لك في الملف المرفق بالمشاركة #11 يوجد مساحة خضراء في ورقة (القوات البحريه دليل 2001) وبها أنا وضعت أسماء فروع افتراضية عليك أن تستبدلها بالأسماء الحقيقية أولا

السلام عليكم أخي العزيز أرجو أن تقرأ الرد في المشاركة #11 بعناية والتي بها المرفق الذي أقصده

السلام عليكم مرفق الملف وبه الكود لجمع a1 b1 c1 لكل الصفحات في الخلية D2 من الورقة الأولي وهذا هو الكود في حدث الملف Private Sub Workbook_NewSheet(ByVal Sh As Object) 'هنا يتم تفعيل الكود إذا أنشأت صفحة جديدة total_A1 End Sub Private Sub Workbook_Open() 'هنا يتم تفعيل الكود عند فتح البرنامج total_A1 End Sub Sub total_A1() ' هذا هو الكود المطلوب Sheet1.[D2] = 0 For i = 1 To Sheets.Count Sheet1.[D2] = Sheet1.[D2] + Sheets(i).[A1] + Sheets(i).[B1] + Sheets(i).[C1] Next i End Sub Private Sub Workbook_SheetActivate(ByVal Sh As Object) 'هنا يتم تفعيل الكود إذا انتقلت من صفحة لأخري total_A1 End Sub المجموع في الخلية_D2.rar

السلام عليكم الخطأ لأن الكود لم يتم تعديله بعد آخر سطر في ردي السابق

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

السلام عليكم أخي الكريم هذا العيب في الورقة 1 لأنك لم تثبت مجال معادلة البحث بمعني أن المعادلة بالخلية AD4 ستبحث بالمجال A2:A399000 وعند نسخها للأسفل بالخلية AD5 فستبحث بالمجالA3:A399001 وهكذا تخرج من البحث الخلايا الأولي فالثانية .. كلما نسخت للأسفل والحل يكون بتثبيت المجالات - بالخلية AD4 غير المعادلة إلي =SUMIFS(مبيعات!$A$2:$A$399000,مبيعات!$E$2:$E$399000,A4,مبيعات!$F$2:$F$399000,"ت") ثم إنسخها للأسفل

السلام عليكم تفضل أخي الكود التالي في حدث الملف سيقوم بجمع الخلية A1 من جميع الشيتات إلي الخلية C1 في الورقة الأولي Private Sub Workbook_NewSheet(ByVal Sh As Object) 'هذا يفعل الكود إذا أنشأت صفحة جديدة total_A1 End Sub Private Sub Workbook_Open() 'هذا يفعل الكود عند فتح البرنامج total_A1 End Sub Sub total_A1() ' هذا هو الكود المطلوب Sheet1.[C1] = 0 For i = 1 To Sheets.Count Sheet1.[C1] = Sheet1.[C1] + Sheets(i).[A1].Value Next i End Sub Private Sub Workbook_SheetActivate(ByVal Sh As Object) 'هذا يفعل الكود إذا انتقلت من صفحة لأخري total_A1 End Sub

السلام عليكم أخي الكريم وأستاذي الفاضل / محمد صالح ، حفظه الله الطبيعي أنه لابأس من مداخلة اي عضو للإثراء وتعدد الحلول فما بالك إن كانت المداخلة من مدير قسم وأخ متميز وأستاذ كبير بالعكس أنا تشرفت والله بالمداخلة الأخت الفاضلة / هديل كما أجابك أخونا الأستاذ العزيز/ عباس السماوي وأضيف أيضا أنني تعمدت أن أوضح لك ذلك (فقد لونته بالأحمر لأنبهك لذلك) (1) العمود الأصفر (D) : تعتمد المعادلة علي أن جميع الورقات الفرعية نهايتها عند السطر 140 وهذا قد لايكون صحيحا في جميع الورقات لذلك طورتها إلي (2) العمود الأخضر (H) : تعتمد المعادلة علي أن معادلة أخري في العمود المجاور (I) ،عمود مساعد، تعد البيانات في العمود (D) بالورقة الفرعية (3) العمود البرتقالي (K) : نفس حل العمود الأخضر ولكن تم دمج المعادلتين لكيلا نحتاج إلي عمود ولكن المعادلة ستكون كبيرة كما أوضحت بالملف

السلام عليكم أخي العزيز لايوجد مرفق وسأغير العنوان لمخالفته لقواعد المنتدي

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

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

السلام عليكم في المرفق ستجد الآتي تم تسمية مجالات الفروع باسم المصارف وتم تحديد مجال الفروع في الجدول بمعني أنه إذا كان للمصرف التجاري الفروع التالية : الرئيسي , وكالة السواني , الزاوية , العجيلات , ترهونه , الخمس , الرشيد , الرئيسي (2) , الزاوية (2) , السواني , العربان , العمامرة , الماية , المختار , المغاربة , بن عاشور , جنزور , ح.الاندلس بينما لمصرف الامان مثلا خمس فروع فقط (الرئيسي , فرع 01 , فرع 02 , فرع 03 , فرع 04) فعند إختيار المصرف التجاري العمود ® سيتاح لك في خلية الفروع المقابلة له بالعمود (S) فقط فروع المصرف التجاري وكذلك الحال لمصرف الامان وهكذا وفي هذه الحالة يمكن تغيير الكود ليكون اسم الورقة مركب من اسم المصرف والفرع سويا مثلا ( التجاري - بن عاشور) أو (ش_افريقيا - وكالة السواني) إذا كان هذا يناسبك عدلت لك الكود وإلا إفحص المرفق وأخبرني رأيك دليل المرتبات2.rar

السلام عليكم أخي الكريم عدل الكود ليصبح كالتالي Sub Macro1() 'TAREQ MAHMOUD mySht = ActiveSheet.Name nm = [A4]: fr_D = ">=" & Format([B4], "000"): to_D = "<=" & Format([C4], "000") LC = [IV4].End(xlToLeft).Column For c = 4 To LC comp = Format(Sheets(mySht).Cells(4, c), "#") For i = 1 To Sheets.Count If Sheets(i).Name = comp Then Reply = MsgBox("الورقة " & comp & " موجودة من قبل " & Chr(10) & " هل تريد اعاده النسخ لنفس الصفحه", vbYesNo) If Reply = 6 Then GoTo 10 Exit Sub End If Next i Sheets.Add After:=Sheets(Sheets.Count) ActiveSheet.Name = comp 10 Sheets("بيانات").Select LR = [V10000].End(xlUp).Row ActiveSheet.AutoFilterMode = False With ActiveSheet.Range("$A$3:$V$" & LR - 2) .AutoFilter Field:=1, Criteria1:=fr_D, Operator:=xlAnd, Criteria2:=to_D .AutoFilter Field:=6, Criteria1:=nm .AutoFilter Field:=7, Criteria1:=comp End With Sheets(comp).Select [A1:W500].FillRight Sheets("بيانات").Range("A1:V" & LR).Copy ([A1]) Columns("A:V").EntireColumn.AutoFit Application.CutCopyMode = False ActiveSheet.DisplayRightToLeft = True Next c MsgBox ("تم إضافة عدد " & LC - 3 & " ورقات") End Sub أو تفضل المرفق كود الترحيل الى صفحات2.rar

السلام عليكم جزاك الله خيرا أخي / محمدي وبارك الله فيك وطبعا هذا ليس بغريب علي أستاذنا الجليل / عبدالله باقشير أدامه الله لنا مرجعا وحفظه من كل سوء

السلام عليكم أخي العزيز أولا: لاداعي لأي حرج ثانيا: لايوجد أي شرح بالملف الذي أرسلته !!!!!!! ولكن ، لاتبدأ من الصفر : إن كنت تريد إضافات أو شرح ، فلتفعل ذلك علي آخر نسخة في المشاركات وأقصد بها الملف "القوات البحريه دليل 2001_1.xlsb" الذي أرسلته أنا لك سابقا عموما : بالنسبة للسؤال نعم يمكنك ذلك ، شاهد المرفق لاأعرف العدد الأقصي ولكن أذكر أنني ذات مرة تعاملت مع ملف به 1500 شييت (صفحة - ورقة) Insert_Data.rar

السلام عليكم أخي العزيز هذا هو الكود Sub Macro1() 'TAREQ MAHMOUD nm = [A4]: comp = Format([B4], "#"): fr_D = ">=" & Format([C4], "000"): to_D = "<=" & Format([D4], "000") For i = 1 To Sheets.Count If Sheets(i).Name = comp Then Reply = MsgBox("الورقة " & comp & " موجودة من قبل " & Chr(10) & " هل تريد اعاده النسخ لنفس الصفحه", vbYesNo) If Reply = 6 Then GoTo 10 Exit Sub End If Next i Sheets.Add After:=Sheets(Sheets.Count) ActiveSheet.Name = comp 10 Sheets("بيانات").Select LR = [V10000].End(xlUp).Row ActiveSheet.AutoFilterMode = False With ActiveSheet.Range("$A$3:$V$" & LR - 2) .AutoFilter Field:=1, Criteria1:=fr_D, Operator:=xlAnd, Criteria2:=to_D .AutoFilter Field:=6, Criteria1:=nm .AutoFilter Field:=7, Criteria1:=comp End With Sheets(comp).Select [A1:W500].FillRight Sheets("بيانات").Range("A1:V" & LR).Copy ([A1]) Columns("A:V").EntireColumn.AutoFit Application.CutCopyMode = False ActiveSheet.DisplayRightToLeft = True End Sub وهذا الملف مرفق ، تفضل كود الترحيل الى صفحات.rar

السلام عليكم الأخ العزيز الخليه B4 بها رقم سيارة أين ذلك في ورقة البيانات مثلا إن كان ماتقصد هو مافي ورقة البيانات بالخلية P124:P126 يعني 39/4 فلابد من استبدال / بإشارة أخري لأنها غير مقبولة في مكونات اسم الورقة الأفضل أن ترسل مثال كامل وتعمل الخطوات يدويا علي إحدي السيارات

السلام عليكم أخي العزيز أولا: قمت ببعض التعديلات الطفيفة، التي ستحسن من أداء الملف >>> مثل إلغاء الصفوف والأعمدة الغير مستخدمة ___ وكذلك تم حفظه بفورمات xlsb مما يساعد علي تقليل حجم الملف بصورة كبيرة ثانيا: دالة التفقيط المستخدمة بالملف لم تكن موجودة لأنك حفظته بفورمات xlsx مما لا يحفظ الأكواد وهي دالة مستحدثة بالأكواد ___ تم نسخها من عمل آخر وأصبحت موجودة بالملف ثالثا: تم الإحتفاظ بأسماء الورقات التي بها مصارف بالخلايا AD11:AD29 كما ستلاحظ بالمرفق وأخيرا عمل الكود اللازم للترحيل وكود آخر لمسح البيانات من ورقات المصارف ويعملان علي الزرين الأحمر والأزرق تفضل المرفق ولاحظ الحجم القوات البحريه دليل 2001_1.rar

السلام عليكم أخي العزيز استعمل الدالة subtotal(9,range) أنظر المرفق subtotal.rar

السلام عليكم أخي العزيز المعادلة التي تستخدمها أنت ، مضبوطة لأن معظم الحالات تكون الفاتورة الواحدة بها أصناف من أكثر من قسم واحد فأنت تلجأ في المعادلة للعمود U الذي به سعر الصنف وهذا مضبوط لم أفهم ماتريد بالضبط

السلام عليكم أخي الكريم تفضل المرفق وبه ماطلبت EXEMPLE2.rar

مرفق الملف بع التعديل تقريرالمبيعات2.rar