طارق محمود

النقطة التالية هذا الخطأ يحدث لأني جعلت المقارنة بين إسم الحساب في ورقة الـ JV والورقة التي سيرحل إليها مثلا إذا عندك حركتين أولا من ح/ مجمع إهلاك أصول ثابتة ثم إلي ح/مجمع إهلاك وسائل نقل وإنتقال عند ترحيل الأولي ، لن يجد هذا الحساب في الورقة الفرعية سيعطي الرسالة ثم يجده في الرئيسية فيرحله وعند ترحيل الحركة الثانية ، سيجد هذا الحساب في الورقة الفرعية فيرحله ثم يكمل للورقة الرئيسية فلايجده فسيعطي الرسالة لذلك سأعدل هذه الجزئية

وشرح سريع لهذه الجزئية من الكود كل مايسبقها هو تأكيد أن البيانات مضبوطة وأن رقم القيد قد تم عمله وشرح الكيد في الخلية E44 موجود و.... كل الشروط التي طلبتها ثم في الأخير الجزء بين السطرين 20 ، 10 والخاص بالنقل لليومية الفرعية ينقل البيانات التي سبق تخزينها في متغيرين deb , crd للدلالة علي داءن ومدين وقد أضفت لهما شرط إن كان المدين لايحتوي علي شيء فلتنقل قيمة الدائن فقط وإلا لتنقل قيمة المدين فقط ونفس الحال بالنسبة للجزء بين السطرين 40 ، 30 والخاص بالنقل لليومية العامة

السلام عليكم أخي العزيز / عيد سأتناول الحلول معك نقطة بنقطة ضع التالي مكان الجزء من السطر رقم 20 إلي رقم 10 20 'Remember t = Right Column No If crd = "" Then .Cells(LastRow, t) = .Cells(LastRow, t) + deb Else .Cells(LastRow, t + 1) = .Cells(LastRow, t + 1) + crd End If 10 Next R ومثله مكان الجزء من السطر رقم 40 إلي رقم 30 40 'Remember t = Right Column No If crd = "" Then .Cells(LastRow, t) = .Cells(LastRow, t) + deb Else .Cells(LastRow, t + 1) = .Cells(LastRow, t + 1) + crd End If 30 Next R

السلام عليكم جزاك الله خيرا أخي أبا الحسن ولك مثل مادعوت وأكثر بإذن الله بالفعل هذا موجود ضمن الملف إرجع للمشاركة رقم #29 في الصفحة الثانية من الموضوع وهذا هو الكود تضيفه في حدث الورقة لجميع الورقات Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'Next r If Target.Column <> 1 Or Target.Row < 5 Then Exit Sub Dim Tot(99) As Integer 'تسجيل اماكن إنتهاء الشهر والتي سيكون بها الإجمالي LstR = [a1000].End(xlUp).Row For a = 5 To LstR - 1 If Month(Cells(a, 1)) <> Month(Cells(a + 1, 1)) Then X = X + 1: Tot(X) = a Next a X = X + 1 Tot(X) = LstR For y = X To 1 Step -1 If Cells(Tot(y), 2) <> "الاجمالى" Then Cells(Tot(y) + 1, 1).Range("A1:H1").Insert Shift:=xlDown Cells(Tot(y) + 1, 1).Range("A1:H1").Interior.ColorIndex = 8 Cells(Tot(y) + 1, 2) = "الاجمالى" LstDat = Cells(Tot(y), 1).Value m = Month(LstDat): yr = Year(LstDat) If m = 12 Then m = 0 Cells(Tot(y) + 1, 1).Value = DateValue("01-" & m + 1 & "-" & yr) - 1 End If Next y 'تسجيل اماكن بها الإجمالي LstR = [a1000].End(xlUp).Row Tot(0) = 5 X = 0 For a = 5 To LstR If Cells(a, 2) = "الاجمالى" Then X = X + 1: Tot(X) = a Next a For y = 1 To X For b = 1 To 4 ' ' ب1 ، ب2 ، ب3 ، ب4 rr = Tot(y) - Tot(y - 1) - 1 Cells(Tot(y), b + 4).FormulaR1C1 = "=SUM(R[-" & rr & "]C:R[-1]C)" Next b Next y End Sub

السلام عليكم تفضل أخي الملف المرفق تطبيق قاعدة معينة في الحساب2.rar

السلام عليكم أخي أباالحسن أكرمك الله تم عمل كود الترحيل علي أساس الملف الذي أرسلته أولا وفيه كان شيت التقرير رقم1 لذلك تجد في أول الكود أنه يتجاهل الشيت 1 ويبدأ في التعامل مع الجميع الشيتات بداية من رقم 2 For sh = 2 To Worksheets.Count Sub AbulHassan() 'مسح البيانات القديمة Range("B2:M4000").ClearContents On Error Resume Next For sh = 2 To Worksheets.Count For a = 5 To Sheets(sh).[b1000].End(xlUp).Row لتوفير الجهد والوقت أخي الكريم إرسل الملف كاملا ولو فيه أسرار عمل إرسل علي الإميل البرنامج في مثل هذه الحالات ، تفصيل حسب الحاجة ، لابد أن يلم معد البرنامج بكل التفاصيل

لاتنسي وضع الكود في حدث الورقة لجميع الورقات

السلام عليكم ضع الكود التالي في حدث الورقة Private Sub Worksheet_Change(ByVal Target As Range) TC = Target.Column TR = Target.Row If TC <> 2 Or TR < 6 Then Exit Sub If Target.Value = "الاجمالى" Then LstT_R = 4 For i = 5 To TR - 1 If Cells(i, 2) = "الاجمالى" Then LstT_R = i Next i For b = 5 To 8 ' ' ب1 ، ب2 ، ب3 ، ب4 rr = TR - LstT_R - 1 Cells(TR, b).FormulaR1C1 = "=SUM(R[-" & rr & "]C:R[-1]C)" Next b End If End Sub

السلام عليكم عفوا أخي النت كان غير مضبوط سأجيب نقطة بنقطة في الكود Sub Sum_Auto() غير السطر Tot(0) = 5 ليكون Tot(0) = 4 في الجزء 'تسجيل اماكن بها الإجمالي LstR = .[a1000].End(xlUp).Row Tot(0) = 4

السلام عليكم أخي عيد تفضل المرفق لم أجربه فقط نسقت أسماء الحسابات Statement to Send_ALL4.rar

السلام عليكم اعتقد انك لن تحتاج عملية الأوتوماتيك بعد مشاهدة المرفق عدد الشيتات كما هو 51 بالإضافة إلي شيت التجميع في الأول واسمه ALL وكذلك كود علي الورقة (1) والتي رقمها في الأكواد Sheet11 إن أردت إنسخه لباقي الورقات ============================================ شرح سريع للكود ========================================= هذا الكود يعمل عن طريق الدبل كليك علي العمود الأول (التاريخ) ويقوم بعمل فحص للتاريخ عندما يجد الشهر قد تغير يفحص الخلية المجاورة ، هل بها كلمة الاجمالي إذا لم يجد ، يقوم بإدراج سطر للأسفل وإضافة كلمة الاجمالي وغضافة أيضا تاريخ آخر يوم بالشهر ثم أخيرا يقوم بالمرور مرة اخري علي جميع السطور التي بها كلمة الاجمالي ويسجل عدد الأسطر بينها وبين مايسبقها من كلمة الاجمالي ثم يضع المعادلات لجمع ب1 ، ب2 ، ب3 ، ب4 وهكذا ... ========================================= هذا الكود موجود مرة أخري في الورقة الأولي ALL علي زر (تنفيذ الجمع مع كتابة كلمة الاجمالى اوتوماتيكيا في جميع الشيتات) لعمل نفس الإجراءات ولكن علي الشيتات جميعها فيما عدا الورقة الأولي ALL وقد أضفت أيضا ضعت صفوف جديدة باللون الأزرق في كل الشيتات بدون إجماليات ، بعد الصف 31 لمراجعة أن الكود يعمل علي جميع الشهور وجميع الشيتات تفضل ، إن شاء الله يكون به ماتريد الارتباطات.rar

السلام عليكم أخي وأستاذي الحبيب / يحي حسين أعذرني لتأخري وذلك لقلة دخولي للمنتدي الإجتماعي بورك فى الموهوب و شكرت الواهب ، و رزقت بره و بلغ أشده بارك الله لكما فيه أخي يحيى وجعله لكما برّأه من النار إن شاء الله

السلام عليكم ليكن أخي الحبيب ولذلك ، سأغلق هذا الموضوع وليكن من الغد بدء العمل علي موضوعك الآخر فهو أشمل ويتضمن هذا الموضوع داخله

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

السلام عليكم أخي الحبيب بالفعل كان الكود يحتاج تعديل طفيف وأيضا أسماء الشيتات في (الملف تقرير) لابد أن يكون بصيغة تيكست أو تضع قبله أبوستروف في حالة أن يكون إسم الشييت رقم (مثل 1،2،3..) تفضل المرفقات ويوجد بملف الإرتباطات أكثر من 50 شييت abuElhassan.rar

السلام عليكم أخي العزيز ماطلبته كثير لعل ذلك هو مايجعل الإخوة لايقبلون علي المشاركة عموما تفضل المرفق وبه معظم ماطلبته إلا "خاصية إستدعاء لتعديل قيد سبق إدخالة." Statement to Send_ALL2.rar

السلام عليكم تفضل أخي الملف وبه الكود المعدل Sub Kh_Start() On Error Resume Next Dim MyRang As Range Dim LastRow As Integer, M As Integer, R As Integer, C As Integer '=========================================== 'عدد صفوف القيد المرحل زايداً فارق الصفوف في الورقةوهي 10 صفوف M = [E1000].End(xlUp).Row '=========================================== 'اذا كان القيد غير متوازن لا يتم الترحيل If [C45] <> [D45] Then MsgBox "القيد غير متوازن", 524288, "تنبيه": Exit Sub '=========================================== With Sheet55 '=========================================== 'اذا كانت آخر خلية في العمود الثالث في اليومية التحليلية 'اصغر من 6 يبدا من الصف رقم 4 والا يعتمد آخر صف بزيادة صف واحد LastRow = .Cells(1000, 3).End(xlUp).Row + 1 If LastRow < 4 Then LastRow = 4 '=========================================== 'Application.ScreenUpdating = False .Cells(LastRow, 1) = [b2] .Cells(LastRow, 2) = [b3] For R = 7 To M deb = Cells(R, 3): crd = Cells(R, 4): Acnt = Cells(R, 5).Value If deb = "" And crd = "" Then GoTo 10 For t = 6 To 278 Step 2 x = .Cells(2, t) If x = Acnt Then GoTo 20 Next t MsgBox ("Not Exist Record") Exit Sub 20 'Remember t = Right Column No .Cells(LastRow, t) = .Cells(LastRow, t) + deb .Cells(LastRow, t + 1) = .Cells(LastRow, t + 1) + crd 10 Next R End With Application.ScreenUpdating = True MsgBox ("تم الترحيل بنجاح" & Chr(10) & "الحمد لله") '=========================================== 'لو أردت مسح الخلايا المنقولة ، فقط فعل السطر التالي بإزالة الأبوستروف من اوله 'Range("B2:B3,C7:E44").ClearContents '=========================================== On Error GoTo 0 End Sub Statement to Send (CODES)2.rar

السلام عليكم أخي العزيز أولا هذا الكود من أعمال العلامة الجليل / خبور خير ، سلمه الله من كل شر << عادة مايبدأ إسم أكواده بحرفي Kh - وقد وجدت إسم الكود Sub Kh_Start() >> ثانيا الغرض من الكود لم يكن كما تريد ، فقد تم تصميمه لشيئ آخر ثالثا ماتطلبه يحتاج بعض الوقت ، سأعمل عليه إن شاء الله

السلام عليكم لاأستطيع المساعدة إلا علي نسخة من ملف الإرتباطات كما هو لديك وفي النسخة كما اتفقنا إعمل الآتي شيت بشيت (ورقة بورقة) قف علي الخلية J200 مثلا ثم من عندها CTRL-SHIFT-END ثم CTRL-SPACE لتظلل كل ماوراء ذلك من صفوف بيانات كليك يمين ، إحذف كل تلك السطور كرر ذلك علي الشيتات كلها إحفظ الملف الجديد ستجد الحجم نزل إلي أقل من ميجا واحدة جرب من فضلك

هاقوللك علي حل سريع إعمل نسخة من الملف وفي النسخة إما تعمل الآتي شيت بشيت (ورقة بورقة) أو تعلم علي الشيتات كلها وتعمل الآتي تترك فقط عشرة أو عشرين سطر بيانات ثم تظلل الأسطر كاملة من السطر الواحد والعشرون لآخر الشيت ثم تلغيها وتحفظ الملف (النسخة الجديدة) ستجد الحجم نزل من 70 ميجا إلي ميجا واحدة علي الأكثر

كم مساحته بعد الضغط بالوينرار أو الوينزيب wimzip - winrar إذا كان بعد الضغط لايزال كبيرا عن المساحة المسموحة في المنتدي إرفعه مضغوطا علي الفورشيرد www.4shared.com

السلام عليكم أخي ابو الزوز حاولت شرح مقتضب في الكود التالي Sub nn () Application.ScreenUpdating = False 'مسح أي بيانات قديمة في الصفحات الموجودة غير الأولي For i = 2 To Sheets.Count - 1 Sheets(i).Select Range("A5:G2000").ClearContents Next i On Error Resume Next 'قراءة وترحيل بيانات الصفحة الأولي واحدة بواحدة Sheets(1).Select For rr = 5 To [c10000].End(xlUp).Row nam = Cells(rr, "C") L_nam = "السـيد " & nam & " المحترم" debt = Cells(rr, "A") cdrt = Cells(rr, "B") Range(Cells(rr, "D"), Cells(rr, "G")).Copy For i = 2 To Sheets.Count If Sheets(i).[b1] = L_nam Then L_R = Sheets(i).[c10000].End(xlUp).Row + 1 ' آخر صف في الورقة المرحل إليها Sheets(i).Cells(L_R, "D").PasteSpecial Paste:=xlPasteValues Sheets(i).Cells(L_R, "C") = "دفعة نقدية" 'مراجعة ماإذا كانت الدفعة دائنة ام مدينة ووضعها في المكان المناسب If debt = 0 Then Sheets(i).Cells(L_R, "A") = cdrt Else Sheets(i).Cells(L_R, "B") = debt GoTo 10 End If Next i 10 Next rr Application.CutCopyMode = False For i = Sheets.Count - 1 To 1 Step -1 Sheets(i).Select [A5].Select Next i Application.ScreenUpdating = True End Sub حاول تمشي معاه ومرفق الملف أيضا وإسأل لو إحتجت أي شيء طلب في الترحيل.rar

السلام عليكم أخي الكريم بالتنسيق الشرطي ضع هذا الشرط =$B3>INT($B3) أو أنظر المرفق MM-STOCK-26-12-1432_2.rar

السلام عليكم أخي وائل أولا جرب علي اللابتوب ملفات أخري عليه من قبل إن لم يقبل الربط بينها ، تكون نسخة الأوفيس عليه محتاجة لإعادة تنصيب إن قبل الربط ، يكون العيب في الملف اللي علي الكمبيوتر الأول (مثلا عليه حماية أو ماشابه) أو إرسل نسخة وستجد الكثير ممن يمد لك يده

السلام عليكم نعم إن شاء الله لها أكثر من حل أسهلها إستخدام عمود مساعد (نظرا لاستهلاك العدد المسموح من دالة IF في خلايا العمود G) ليكن عن طريق إضافة عمود A لا يطبع يحتوي علي موعد الإنصراف ثم نغير المعادلة في خلايا العمود G لتأخذ منه بدلا من الخلية الثابتة F3 التي كانت E3 قبل إضافة العمود أنظر المرفق MASTER0_5.rar