onlymanly

الأستاذ الخالدي....ألف شكر .... ملفك عز الطلب .. اكرر شكري لك و بارك الله لك في عمرك

أخي الخالدي.. الان فقط فهمت ملفك ... و هو قريب من طلبي ينقصه فقط . أن يكون الترقيم تلقائيا حسب ما صنعت أنت ....

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

أكرمك الله أستاذ طارق ع الرد ... مقصودي: أن القائمة A:B الأرقام و الأسماء أضفت لهم تصنيف رئيسي مثال: المبيعات رقم:6002 و التصنيف العام : المتاجرة. فتصنيف المتاجرة مثلا أريد أن تكون أرقام الحسابات فيه تبدأ من 7000-7999 .. فلو أضفت في عمود A إسم معين و في عمود C تصنيف متاجرة اريد ان يكون رقم العميل لا يتجاوز ما بين 7000-7999 من غير التعرض لما هو مسجل في القائمة بنفس التصنيف و لكن يتم وضع رقم غير محجوز في القائمة ولا يتعدى ال 7000- 7999 مثلا و في المرفق جدول يبين الأسماء التي جعلتها تصانيف رئيسية و بجانبها نطاق الأرقام المحددة

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

طلع ولدا صالحا إن شاء الله .. و جزاك الله الف خير

ولا عيب فيهم غير أن سيوفهم............ بهن فلولٌ من قراع الكتائب هذا ما يقال لك أستاذ طارق.. لا يعبيبك شيء .. اقدر ضيق وقتك و انشغالك فلكل أعماله و مهامه .. جزاك الله خيرا .. و بارك لك و فيك.. ونحن في خدمتك أستاذ طارق.... التعديل ضبط معي 100%

تعتبك معاي استاذ طارق.. للاسف ظهرت مشكلة أخرى عند الترحيل:) فإذا كان الملف المرحل إليه لا يوجد فيه سوى ورقة samble فإنه عند الترحيل ينشئ أوراق جديدة بنفس الأسماء الموجودة في ملف القيود .. و لكن من غير أي بيانات ما عدى الإسم ورقم الحساب فقط لا غير.. و عند محاولة الترحيل مرة أخرى فإنه يضع لأول عميل المبلغ مع باقي البيانات و غيره من العملاء فلا يسجل في صفحاتهم شيء...إنما يكرر أوراق أخرى بإسم samble (1) و هكذت حتى يصل لكل الأسماء الموجودة في ملف القيود حتى ورقة samble (20). حقيقة استاذ طارق غلبتك معاي و أنا كذلك لقيت من أمري رهقا .. و السبب هو قصوري في معرفة هذا العلم.. أرفقت لك صور للنتائج المكتوبة في كلامي P.rar

أستاذ طارق عن إذنك سأضيفك في ماسنجري ..

العفو استاذي ع التاخير كنت في سفر ... اتفضل المرفق راجيا ان يساعدك الله و يمدك on.rar

سبحان الله ما أروع هذه الطلاسم :) اختصار رهيب .. لكن استاذ طارق.. المف يقف عند النقطة التي ستراها في الصورة طبعا بعدين عدلت : If WorksheetFunction.Mod(qq, 2) = "" Then qaid_f = 1 Else qaid_f = -2 بإضفة حرف (e)إلى : If WorksheetFunction.Mode(qq, 2) = "" Then qaid_f = 1 Else qaid_f = -2 و كذلك غلط يقول: أن WorksheetFunction.Mode من الفئة لا يمكن الحصول ع الخاصية

اسعد الله صباحك مولانا .. استفدت كثيرا من هذا المنتدى و منك بالذات فجزاك الله خيرا... اسمح لي أن أطرح بعض التساؤلات: أولا: في القيود: الكود التالي: Sub QID() Dim xxx As String S_NAMESANAD = Range("E2").Value '______________________________________________ Range("IV1").Value = Range("IV1").Value + 1 ' '______________________________________________ S_KIND = "QAID" S_SER = Range("E2").Value S_DATE = Range("B3").Value '______________________________________________ Dim s_name(99) As Variant For I = 1 To 20 s_name(I) = Range("B" & I + 4).Value Next I '______________________________________________ Dim S_ACC(99) As Variant For I = 1 To 20 S_ACC(I) = Range("IU" & I + 4).Value Next I '______________________________________________ Dim s_amount(99) As Variant For I = 1 To 20 s_amount(I * 2 - 1) = Range("C" & I + 4).Value s_amount(I * 2) = Range("D" & I + 4).Value Next I '______________________________________________ Dim S_explain(99) As Variant For I = 1 To 20 S_explain(I) = Range("E" & I + 4).Value Next I '______________________________________________ A = Workbooks.Count X = "Close" For I = 1 To A If Workbooks(I).Name = "2.xls" Then X = "OPEN" Next I If X = "Close" Then xxx = ActiveWorkbook.Path & "\" & "2.xls": Workbooks.Open xxx Windows("2.xls").Activate '______________________________________________ 'ACC(1) X = Worksheets.Count For I = 1 To X If Worksheets(I).Name = s_name(1) Then GoTo 100 Next I Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = s_name(1) Range("C1").Value = S_ACC(1) Range("F3").Value = s_name(1) 100 Worksheets(s_name(1)).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = s_amount(1) ActiveCell.Offset(0, 2).Value = s_amount(2) ActiveCell.Offset(0, 5).Value = S_explain(1) ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = s_name(2) '______________________________________________ 'ACC(2) X = Worksheets.Count For I = 1 To X If Worksheets(I).Name = s_name(2) Then GoTo 200 Next I Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = s_name(2) Range("C1").Value = S_ACC(2) Range("F3").Value = s_name(2) 200 Worksheets(s_name(2)).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = s_amount(3) ActiveCell.Offset(0, 2).Value = s_amount(4) ActiveCell.Offset(0, 5).Value = S_explain(2) ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = s_name(1) '______________________________________________ 'ACC(3) X = Worksheets.Count For I = 1 To X If Worksheets(I).Name = s_name(3) Then GoTo 300 Next I Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = s_name(3) Range("C1").Value = S_ACC(3) Range("F3").Value = s_name(3) 300 Worksheets(s_name(3)).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = s_amount(5) ActiveCell.Offset(0, 2).Value = s_amount(6) ActiveCell.Offset(0, 5).Value = S_explain(3) ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = s_name(4) '______________________________________________ 'ACC(4) X = Worksheets.Count For I = 1 To X If Worksheets(I).Name = s_name(4) Then GoTo 400 Next I Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = s_name(4) Range("C1").Value = S_ACC(4) Range("F3").Value = s_name(4) 400 Worksheets(s_name(4)).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = s_amount(7) ActiveCell.Offset(0, 2).Value = s_amount(8) ActiveCell.Offset(0, 5).Value = S_explain(4) ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = s_name(3) '______________________________________________ 'ACC(5) X = Worksheets.Count For I = 1 To X If Worksheets(I).Name = s_name(5) Then GoTo 500 Next I Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = s_name(5) Range("C1").Value = S_ACC(5) Range("F3").Value = s_name(5) 500 Worksheets(s_name(5)).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = s_amount(9) ActiveCell.Offset(0, 2).Value = s_amount(10) ActiveCell.Offset(0, 5).Value = S_explain(5) ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = s_name(6) '______________________________________________ 'ACC(6) X = Worksheets.Count For I = 1 To X If Worksheets(I).Name = s_name(6) Then GoTo 600 Next I Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = s_name(6) Range("C1").Value = S_ACC(6) Range("F3").Value = s_name(6) 600 Worksheets(s_name(6)).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = s_amount(11) ActiveCell.Offset(0, 2).Value = s_amount(12) ActiveCell.Offset(0, 5).Value = S_explain(6) ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = s_name(5) '______________________________________________ 'ACC(7) X = Worksheets.Count For I = 1 To X If Worksheets(I).Name = s_name(7) Then GoTo 700 Next I Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = s_name(7) Range("C1").Value = S_ACC(7) Range("F3").Value = s_name(7) 700 Worksheets(s_name(7)).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = s_amount(13) ActiveCell.Offset(0, 2).Value = s_amount(14) ActiveCell.Offset(0, 5).Value = S_explain(7) ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = s_name(8) '______________________________________________ 'ACC(8) X = Worksheets.Count For I = 1 To X If Worksheets(I).Name = s_name(8) Then GoTo 800 Next I Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = s_name(8) Range("C1").Value = S_ACC(8) Range("F3").Value = s_name(8) 800 Worksheets(s_name(8)).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = s_amount(15) ActiveCell.Offset(0, 2).Value = s_amount(16) ActiveCell.Offset(0, 5).Value = S_explain(8) ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = s_name(7) '______________________________________________ 'ACC(9) X = Worksheets.Count For I = 1 To X If Worksheets(I).Name = s_name(9) Then GoTo 900 Next I Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = s_name(9) Range("C1").Value = S_ACC(9) Range("F3").Value = s_name(9) 900 Worksheets(s_name(9)).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = s_amount(17) ActiveCell.Offset(0, 2).Value = s_amount(18) ActiveCell.Offset(0, 5).Value = S_explain(9) ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = s_name(10) '______________________________________________ 'ACC(10) X = Worksheets.Count For I = 1 To X If Worksheets(I).Name = s_name(10) Then GoTo 1000 Next I Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = s_name(10) Range("C1").Value = S_ACC(10) Range("F3").Value = s_name(10) 1000 Worksheets(s_name(10)).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = s_amount(19) ActiveCell.Offset(0, 2).Value = s_amount(20) ActiveCell.Offset(0, 5).Value = S_explain(10) ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = s_name(9) '______________________________________________ 'ACC(11) X = Worksheets.Count For I = 1 To X If Worksheets(I).Name = s_name(11) Then GoTo 1010 Next I Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = s_name(11) Range("C1").Value = S_ACC(11) Range("F3").Value = s_name(11) 1010 Worksheets(s_name(11)).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = s_amount(21) ActiveCell.Offset(0, 2).Value = s_amount(22) ActiveCell.Offset(0, 5).Value = S_explain(11) ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = s_name(12) '______________________________________________ 'ACC(12) X = Worksheets.Count For I = 1 To X If Worksheets(I).Name = s_name(12) Then GoTo 1100 Next I Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = s_name(12) Range("C1").Value = S_ACC(12) Range("F3").Value = s_name(12) 1100 Worksheets(s_name(12)).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = s_amount(23) ActiveCell.Offset(0, 2).Value = s_amount(24) ActiveCell.Offset(0, 5).Value = S_explain(12) ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = s_name(11) '______________________________________________ 'ACC(13) X = Worksheets.Count For I = 1 To X If Worksheets(I).Name = s_name(13) Then GoTo 1150 Next I Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = s_name(13) Range("C1").Value = S_ACC(13) Range("F3").Value = s_name(13) 1150 Worksheets(s_name(13)).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = s_amount(25) ActiveCell.Offset(0, 2).Value = s_amount(26) ActiveCell.Offset(0, 5).Value = S_explain(13) ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = s_name(14) '______________________________________________ 'ACC(14) X = Worksheets.Count For I = 1 To X If Worksheets(I).Name = s_name(14) Then GoTo 1200 Next I Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = s_name(14) Range("C1").Value = S_ACC(14) Range("F3").Value = s_name(14) 1200 Worksheets(s_name(14)).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = s_amount(27) ActiveCell.Offset(0, 2).Value = s_amount(28) ActiveCell.Offset(0, 5).Value = S_explain(14) ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = s_name(13) '______________________________________________ 'ACC(15) X = Worksheets.Count For I = 1 To X If Worksheets(I).Name = s_name(15) Then GoTo 1250 Next I Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = s_name(15) Range("C1").Value = S_ACC(15) Range("F3").Value = s_name(15) 1250 Worksheets(s_name(15)).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = s_amount(29) ActiveCell.Offset(0, 2).Value = s_amount(30) ActiveCell.Offset(0, 5).Value = S_explain(15) ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = s_name(16) '______________________________________________ 'ACC(16) X = Worksheets.Count For I = 1 To X If Worksheets(I).Name = s_name(16) Then GoTo 1300 Next I Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = s_name(16) Range("C1").Value = S_ACC(16) Range("F3").Value = s_name(16) 1300 Worksheets(s_name(16)).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = s_amount(31) ActiveCell.Offset(0, 2).Value = s_amount(32) ActiveCell.Offset(0, 5).Value = S_explain(16) ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = s_name(15) '______________________________________________ 'ACC(17) X = Worksheets.Count For I = 1 To X If Worksheets(I).Name = s_name(17) Then GoTo 1380 Next I Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = s_name(17) Range("C1").Value = S_ACC(17) Range("F3").Value = s_name(17) 1380 Worksheets(s_name(17)).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = s_amount(33) ActiveCell.Offset(0, 2).Value = s_amount(34) ActiveCell.Offset(0, 5).Value = S_explain(17) ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = s_name(18) '______________________________________________ 'ACC(18) X = Worksheets.Count For I = 1 To X If Worksheets(I).Name = s_name(18) Then GoTo 1400 Next I Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = s_name(18) Range("C1").Value = S_ACC(18) Range("F3").Value = s_name(18) 1400 Worksheets(s_name(18)).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = s_amount(35) ActiveCell.Offset(0, 2).Value = s_amount(36) ActiveCell.Offset(0, 5).Value = S_explain(18) ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = s_name(17) '______________________________________________ 'ACC(19) X = Worksheets.Count For I = 1 To X If Worksheets(I).Name = s_name(19) Then GoTo 1450 Next I Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = s_name(19) Range("C1").Value = S_ACC(19) Range("F3").Value = s_name(19) 1450 Worksheets(s_name(19)).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = s_amount(37) ActiveCell.Offset(0, 2).Value = s_amount(38) ActiveCell.Offset(0, 5).Value = S_explain(19) ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = s_name(20) '______________________________________________ 'ACC(20) X = Worksheets.Count For I = 1 To X If Worksheets(I).Name = s_name(20) Then GoTo 1480 Next I Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = s_name(20) Range("C1").Value = S_ACC(20) Range("F3").Value = s_name(20) 1480 Worksheets(s_name(20)).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = s_amount(39) ActiveCell.Offset(0, 2).Value = s_amount(40) ActiveCell.Offset(0, 5).Value = S_explain(20) ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = s_name(19) '________________________________________ Windows("1.xls").Activate Range("A1").Select End Sub لاحظ لدينا عشرين حساب ..المشكلة في ورقة القيود ليس بالضرورة أن استعمل ال 20 حساب احيانا قد ارحل لحسابين فقط.. و هنا يقف البرنامج لأن في المايكرو تم ادخال 20 حساب يتم الترحيل إليهم. و أترك التساؤات الأخرى.. بعد التخلص من هذه المشكلة

كيف أختصر كل هذا؟ :) 'S_ACC1 = Range("IU5").Value 'S_ACC2 = Range("IU6").Value 'S_ACC3 = Range("IU7").Value 'S_ACC4 = Range("IU8").Value 'S_ACC5 = Range("IU9").Value 'S_ACC6 = Range("IU10").Value 'S_ACC7 = Range("IU11").Value 'S_ACC8 = Range("IU12").Value 'S_ACC9 = Range("IU13").Value 'S_ACC10 = Range("IU14").Value 'S_ACC11 = Range("IU15").Value 'S_ACC12 = Range("IU16").Value 'S_ACC13 = Range("IU17").Value 'S_ACC14 = Range("IU18").Value 'S_ACC15 = Range("IU19").Value 'S_ACC16 = Range("IU20").Value 'S_ACC17 = Range("IU21").Value 'S_ACC18 = Range("IU22").Value 'S_ACC19 = Range("IU23").Value 'S_ACC20 = Range("IU24").Value '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> For i = 1 To 20 s_amount(i * 2 - 1) = Range("C" & i + 4).Value مثل هذا ؟؟؟ s_amount(i * 2) = Range("D" & i + 4).Value Next i '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< S_explain1 = Range("E5").Value S_explain2 = Range("E6").Value S_explain3 = Range("E7").Value S_explain4 = Range("E8").Value S_explain5 = Range("E9").Value S_explain6 = Range("E10").Value S_explain7 = Range("E11").Value S_explain8 = Range("E12").Value S_explain9 = Range("E13").Value S_explain10 = Range("E14").Value S_explain11 = Range("E15").Value S_explain12 = Range("E16").Value S_explain13 = Range("E17").Value S_explain14 = Range("E18").Value S_explain15 = Range("E19").Value S_explain16 = Range("E20").Value S_explain17 = Range("E21").Value S_explain18 = Range("E22").Value S_explain19 = Range("E23").Value S_explain20 = Range("E24").Value ياريت تعلمني كيف اصطاد السمك ... لم أفهم الكود الذي اختصر لي ال S_ACOUNT و فعلا كان جميل جدا

ياشيخ الله يرحم والديك فرجت عني و الله... خلاص عرفت كيف أدخل الدليل

الصراحة لم اهتد لجعل الملف يرحل نسخة إلى الدليل التالي: D:\Only\ACCOUNTS\ARCHIVES\QS\قبض.xls و هذا موضع الكود الذي يطلب الدليل: a = Workbooks.Count x = "Close" For i = 1 To a If Workbooks(i).Name = "&THORN;&Egrave;&Ouml;.xls" Then x = "OPEN" Next i If x = "Close" Then xxx = ActiveWorkbook.Path & "\" & "&THORN;&Egrave;&Ouml;.xls": Workbooks.Open xxx Windows("&THORN;&Egrave;&Ouml;.xls").Activate x = Worksheets.Count For i = 1 To x If Worksheets(i).Name = S_NAME1 Then GoTo 300 Next i Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = S_NAMESANAD Range("I3").Value = S_NAMESANAD 300 Range("a1000").Select Selection.End(xlUp).Select ActiveCell.Offset(7, 4).Value = S_AMOUNT ActiveCell.Offset(4, 6).Value = S_ACC1 ActiveCell.Offset(11, 6).Value = S_ACC2 ActiveCell.Offset(11, 9).Value = S_DATE ActiveCell.Offset(4, 4).Value = S_NAME1 ActiveCell.Offset(11, 4).Value = S_NAME2 ActiveCell.Offset(9, 4).Value = S_DUL ActiveCell.Offset(9, 10).Value = S_difference_DUL ActiveCell.Offset(9, 12).Value = S_difference_Y ActiveCell.Offset(9, 6).Value = S_SARF Windows("&THORN;&Egrave;&Ouml;.xls").Activate ActiveWorkbook.Close SaveChanges:=True

عند مجلد إسمه الملف الذي منه يتم الترحيل في الدليل DK DK\ACCOUNTS\DATA\2.XLS و هو التي تترحل إليه الحسابات هنا دليل ترحيل نسخ من الفواتير DK\ACCOUNTS\ARCHIVES\INVOICE\INVOICE.XLS هنا دليل ترحيل نسخ من بيان التعبئة DK\ACCOUNTS\ARCHIVES\INVOICE\PACKINGLIST.XLS هنا دليل ترحيل نسخ من سندات القبض كأرشفة DK\ACCOUNTS\ARCHIVES\QS\قبض.XLS هنا دليل ترحيل نسخ من سندات الصرف كأرشفة DK\ACCOUNTS\ARCHIVES\QS\صرف.XLS فكيف أكتبها داخل المايكرو؟ أما القيود فتركت أخذ نسخة احتياطية منها أو أرشفة لها لصعوبتها و لأنها تأخذ وقتا طويلا جدا عليَّ

بارك الله فيك استاذي طارق... اقصد كيف أدخل S_AMOUNT1 حتى S_AMOUNT40 في الموقع أدناه؟ مع رمز اختصارك الذي كتبته لي امس؟ ActiveCell.Offset(0, 1).Value = S_AMOUNT1 ActiveCell.Offset(0, 2).Value = S_AMOUNT2

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

يا سبحان الله .. كم هو شيق هذا العلم... عرفتُ كيف اختصار هذا الأمر بالنسبة لكون الماييكرو يأخذ هذه الأوامر كدليل .. لكن ماذا أكتب كي أحدد موضع هذه الأرقام في صفحة التحريل Worksheets(S_NAME1).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = S_AMOUNT1 ActiveCell.Offset(0, 2).Value = S_AMOUNT2

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

استاذ طارق شوف كود الترحيل بعد أن عدلته كيف صار متشعب Sub &THORN;&iacute;&Iuml;() Dim xxx As String N_sER = N_sER + 1 Range("E2").Value = ("M1") & 31 + N_sER B = MsgBox(" &aring;&aacute; &Atilde;&auml;&Ecirc; &atilde;&Ecirc;&Atilde;&szlig;&Iuml; &Atilde;&auml;&szlig; &Ecirc;&Ntilde;&iacute;&Iuml; &Ecirc;&Ntilde;&Iacute;&iacute;&aacute; &aring;&ETH;&Ccedil; &Ccedil;&aacute;&Oacute;&auml;&Iuml; &iquest;&iquest;&iquest; ", vbOKCancel + vbQuestion + vbMsgBoxRight, " &Icirc;&iacute;&Ccedil;&Ntilde;&Ccedil;&Ecirc; ") If B = vbNo Then GoTo 7 If B = vbOK Then GoTo 66 7 End 66 S_KIND = "&THORN;&iacute;&Iuml;" S_SER = Range("E2").Value S_DATE = Range("B3").Value S_NAME1 = Range("B5").Value S_NAME2 = Range("B6").Value S_NAME3 = Range("B7").Value S_NAME4 = Range("B8").Value S_NAME5 = Range("B9").Value S_NAME6 = Range("B10").Value S_NAME7 = Range("B11").Value S_NAME8 = Range("B12").Value S_NAME9 = Range("B13").Value S_NAME10 = Range("B14").Value S_NAME11 = Range("B15").Value S_NAME12 = Range("B16").Value S_NAME13 = Range("B17").Value S_NAME14 = Range("B18").Value S_NAME15 = Range("B19").Value S_NAME16 = Range("B20").Value S_NAME17 = Range("B21").Value S_NAME18 = Range("B22").Value S_NAME19 = Range("B23").Value S_NAME20 = Range("B24").Value '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> S_ACC1 = Range("IU5").Value S_ACC2 = Range("IU6").Value S_ACC3 = Range("IU7").Value S_ACC4 = Range("IU8").Value S_ACC5 = Range("IU9").Value S_ACC6 = Range("IU10").Value S_ACC7 = Range("IU11").Value S_ACC8 = Range("IU12").Value S_ACC9 = Range("IU13").Value S_ACC10 = Range("IU14").Value S_ACC11 = Range("IU15").Value S_ACC12 = Range("IU16").Value S_ACC13 = Range("IU17").Value S_ACC14 = Range("IU18").Value S_ACC15 = Range("IU19").Value S_ACC16 = Range("IU20").Value S_ACC17 = Range("IU21").Value S_ACC18 = Range("IU22").Value S_ACC19 = Range("IU23").Value S_ACC20 = Range("IU24").Value '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> S_AMOUNT1 = Range("C5").Value S_AMOUNT2 = Range("D5").Value S_AMOUNT3 = Range("C6").Value S_AMOUNT4 = Range("D6").Value S_AMOUNT5 = Range("C7").Value S_AMOUNT6 = Range("D7").Value S_AMOUNT7 = Range("C8").Value S_AMOUNT8 = Range("D8").Value S_AMOUNT9 = Range("C9").Value S_AMOUNT10 = Range("D9").Value S_AMOUNT11 = Range("C10").Value S_AMOUNT12 = Range("D10").Value S_AMOUNT13 = Range("C11").Value S_AMOUNT14 = Range("D11").Value S_AMOUNT15 = Range("C12").Value S_AMOUNT16 = Range("D12").Value S_AMOUNT17 = Range("C13").Value S_AMOUNT18 = Range("D13").Value S_AMOUNT19 = Range("C14").Value S_AMOUNT20 = Range("D14").Value S_AMOUNT21 = Range("C15").Value S_AMOUNT22 = Range("D15").Value S_AMOUNT23 = Range("C16").Value S_AMOUNT24 = Range("D16").Value S_AMOUNT25 = Range("C17").Value S_AMOUNT26 = Range("D17").Value S_AMOUNT27 = Range("C18").Value S_AMOUNT28 = Range("D18").Value S_AMOUNT29 = Range("C19").Value S_AMOUNT30 = Range("D19").Value S_AMOUNT31 = Range("C20").Value S_AMOUNT32 = Range("D20").Value S_AMOUNT33 = Range("C21").Value S_AMOUNT34 = Range("D21").Value S_AMOUNT35 = Range("C22").Value S_AMOUNT36 = Range("D22").Value S_AMOUNT37 = Range("C23").Value S_AMOUNT38 = Range("D23").Value S_AMOUNT39 = Range("C24").Value S_AMOUNT40 = Range("D24").Value '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< S_explain1 = Range("E5").Value S_explain2 = Range("E6").Value S_explain3 = Range("E7").Value S_explain4 = Range("E8").Value S_explain5 = Range("E9").Value S_explain6 = Range("E10").Value S_explain7 = Range("E11").Value S_explain8 = Range("E12").Value S_explain9 = Range("E13").Value S_explain10 = Range("E14").Value S_explain11 = Range("E15").Value S_explain12 = Range("E16").Value S_explain13 = Range("E17").Value S_explain14 = Range("E18").Value S_explain15 = Range("E19").Value S_explain16 = Range("E20").Value S_explain17 = Range("E21").Value S_explain18 = Range("E22").Value S_explain19 = Range("E23").Value S_explain20 = Range("E24").Value '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> a = Workbooks.Count x = "Close" For i = 1 To a If Workbooks(i).Name = "2.xls" Then x = "OPEN" Next i If x = "Close" Then xxx = ActiveWorkbook.Path & "\" & "2.xls": Workbooks.Open xxx Windows("2.xls").Activate '================================================== 'ACC(1) x = Worksheets.Count For i = 1 To x If Worksheets(i).Name = S_NAME1 Then GoTo 100 Next i Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = S_NAME1 Range("C1").Value = S_ACC1 Range("F3").Value = S_NAME1 100 Worksheets(S_NAME1).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = S_AMOUNT1 ActiveCell.Offset(0, 2).Value = S_AMOUNT2 ActiveCell.Offset(0, 5).Value = S_explain1 ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = S_NAME2 'ACC(2) x = Worksheets.Count For i = 1 To x If Worksheets(i).Name = S_NAME2 Then GoTo 200 Next i Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = S_NAME2 Range("C1").Value = S_ACC2 Range("F3").Value = S_NAME2 200 Worksheets(S_NAME2).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = S_AMOUNT3 ActiveCell.Offset(0, 2).Value = S_AMOUNT4 ActiveCell.Offset(0, 5).Value = S_explain2 ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = S_NAME1 '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&*&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& 'ACC(3) x = Worksheets.Count For i = 1 To x If Worksheets(i).Name = S_NAME3 Then GoTo 300 Next i Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = S_NAME3 Range("C1").Value = S_ACC3 Range("F3").Value = S_NAME3 300 Worksheets(S_NAME3).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = S_AMOUNT5 ActiveCell.Offset(0, 2).Value = S_AMOUNT6 ActiveCell.Offset(0, 5).Value = S_explain3 ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = S_NAME4 'ACC(4) x = Worksheets.Count For i = 1 To x If Worksheets(i).Name = S_NAME4 Then GoTo 400 Next i Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = S_NAME4 Range("C1").Value = S_ACC4 Range("F3").Value = S_NAME4 400 Worksheets(S_NAME4).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = S_AMOUNT7 ActiveCell.Offset(0, 2).Value = S_AMOUNT8 ActiveCell.Offset(0, 5).Value = S_explain4 ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = S_NAME3 '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& 'ACC(5) x = Worksheets.Count For i = 1 To x If Worksheets(i).Name = S_NAME5 Then GoTo 500 Next i Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = S_NAME5 Range("C1").Value = S_ACC5 Range("F3").Value = S_NAME5 500 Worksheets(S_NAME5).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = S_AMOUNT9 ActiveCell.Offset(0, 2).Value = S_AMOUNT10 ActiveCell.Offset(0, 5).Value = S_explain5 ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = S_NAME6 'ACC(6) x = Worksheets.Count For i = 1 To x If Worksheets(i).Name = S_NAME6 Then GoTo 600 Next i Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = S_NAME6 Range("C1").Value = S_ACC6 Range("F3").Value = S_NAME6 600 Worksheets(S_NAME6).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = S_AMOUNT11 ActiveCell.Offset(0, 2).Value = S_AMOUNT12 ActiveCell.Offset(0, 5).Value = S_explain6 ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = S_NAME5 '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& 'ACC(7) x = Worksheets.Count For i = 1 To x If Worksheets(i).Name = S_NAME7 Then GoTo 700 Next i Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = S_NAME7 Range("C1").Value = S_ACC7 Range("F3").Value = S_NAME7 700 Worksheets(S_NAME7).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = S_AMOUNT13 ActiveCell.Offset(0, 2).Value = S_AMOUNT14 ActiveCell.Offset(0, 5).Value = S_explain7 ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = S_NAME8 '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& 'ACC(8) x = Worksheets.Count For i = 1 To x If Worksheets(i).Name = S_NAME8 Then GoTo 800 Next i Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = S_NAME8 Range("C1").Value = S_ACC8 Range("F3").Value = S_NAME8 800 Worksheets(S_NAME8).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = S_AMOUNT15 ActiveCell.Offset(0, 2).Value = S_AMOUNT16 ActiveCell.Offset(0, 5).Value = S_explain8 ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = S_NAME7 '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& 'ACC(9) x = Worksheets.Count For i = 1 To x If Worksheets(i).Name = S_NAME9 Then GoTo 900 Next i Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = S_NAME9 Range("C1").Value = S_ACC9 Range("F3").Value = S_NAME9 900 Worksheets(S_NAME9).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = S_AMOUNT17 ActiveCell.Offset(0, 2).Value = S_AMOUNT18 ActiveCell.Offset(0, 5).Value = S_explain9 ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = S_NAME10 '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& 'ACC(10) x = Worksheets.Count For i = 1 To x If Worksheets(i).Name = S_NAME10 Then GoTo 1000 Next i Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = S_NAME10 Range("C1").Value = S_ACC10 Range("F3").Value = S_NAME10 1000 Worksheets(S_NAME10).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = S_AMOUNT19 ActiveCell.Offset(0, 2).Value = S_AMOUNT20 ActiveCell.Offset(0, 5).Value = S_explain10 ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = S_NAME9 '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& 'ACC(11) x = Worksheets.Count For i = 1 To x If Worksheets(i).Name = S_NAME11 Then GoTo 1010 Next i Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = S_NAME11 Range("C1").Value = S_ACC11 Range("F3").Value = S_NAME11 1010 Worksheets(S_NAME11).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = S_AMOUNT21 ActiveCell.Offset(0, 2).Value = S_AMOUNT22 ActiveCell.Offset(0, 5).Value = S_explain11 ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = S_NAME12 '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& 'ACC(12) x = Worksheets.Count For i = 1 To x If Worksheets(i).Name = S_NAME12 Then GoTo 1100 Next i Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = S_NAME12 Range("C1").Value = S_ACC12 Range("F3").Value = S_NAME12 1100 Worksheets(S_NAME12).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = S_AMOUNT23 ActiveCell.Offset(0, 2).Value = S_AMOUNT24 ActiveCell.Offset(0, 5).Value = S_explain12 ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = S_NAME11 '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& 'ACC(13) x = Worksheets.Count For i = 1 To x If Worksheets(i).Name = S_NAME13 Then GoTo 1150 Next i Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = S_NAME13 Range("C1").Value = S_ACC13 Range("F3").Value = S_NAME13 1150 Worksheets(S_NAME13).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = S_AMOUNT25 ActiveCell.Offset(0, 2).Value = S_AMOUNT26 ActiveCell.Offset(0, 5).Value = S_explain13 ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = S_NAME14 '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& 'ACC(14) x = Worksheets.Count For i = 1 To x If Worksheets(i).Name = S_NAME14 Then GoTo 1200 Next i Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = S_NAME14 Range("C1").Value = S_ACC14 Range("F3").Value = S_NAME14 1200 Worksheets(S_NAME14).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = S_AMOUNT27 ActiveCell.Offset(0, 2).Value = S_AMOUNT28 ActiveCell.Offset(0, 5).Value = S_explain14 ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = S_NAME13 '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& 'ACC(15) x = Worksheets.Count For i = 1 To x If Worksheets(i).Name = S_NAME15 Then GoTo 1250 Next i Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = S_NAME15 Range("C1").Value = S_ACC15 Range("F3").Value = S_NAME15 1250 Worksheets(S_NAME15).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = S_AMOUNT29 ActiveCell.Offset(0, 2).Value = S_AMOUNT30 ActiveCell.Offset(0, 5).Value = S_explain15 ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = S_NAME16 '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& 'ACC(16) x = Worksheets.Count For i = 1 To x If Worksheets(i).Name = S_NAME16 Then GoTo 1300 Next i Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = S_NAME16 Range("C1").Value = S_ACC16 Range("F3").Value = S_NAME16 1300 Worksheets(S_NAME16).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = S_AMOUNT31 ActiveCell.Offset(0, 2).Value = S_AMOUNT32 ActiveCell.Offset(0, 5).Value = S_explain16 ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = S_NAME15 '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& 'ACC(17) x = Worksheets.Count For i = 1 To x If Worksheets(i).Name = S_NAME17 Then GoTo 1380 Next i Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = S_NAME17 Range("C1").Value = S_ACC17 Range("F3").Value = S_NAME17 1380 Worksheets(S_NAME17).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = S_AMOUNT33 ActiveCell.Offset(0, 2).Value = S_AMOUNT34 ActiveCell.Offset(0, 5).Value = S_explain17 ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = S_NAME18 '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& 'ACC(18) x = Worksheets.Count For i = 1 To x If Worksheets(i).Name = S_NAME18 Then GoTo 1400 Next i Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = S_NAME18 Range("C1").Value = S_ACC18 Range("F3").Value = S_NAME18 1400 Worksheets(S_NAME18).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = S_AMOUNT35 ActiveCell.Offset(0, 2).Value = S_AMOUNT36 ActiveCell.Offset(0, 5).Value = S_explain18 ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = S_NAME17 '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& 'ACC(19) x = Worksheets.Count For i = 1 To x If Worksheets(i).Name = S_NAME19 Then GoTo 1450 Next i Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = S_NAME19 Range("C1").Value = S_ACC19 Range("F3").Value = S_NAME19 1450 Worksheets(S_NAME19).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = S_AMOUNT37 ActiveCell.Offset(0, 2).Value = S_AMOUNT38 ActiveCell.Offset(0, 5).Value = S_explain19 ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = S_NAME20 '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& 'ACC(20) x = Worksheets.Count For i = 1 To x If Worksheets(i).Name = S_NAME20 Then GoTo 1480 Next i Sheets("sample").Select Sheets("sample").Copy Before:=Sheets(1) ActiveSheet.Name = S_NAME20 Range("C1").Value = S_ACC20 Range("F3").Value = S_NAME20 1480 Worksheets(S_NAME20).Select Range("a1000").Select Selection.End(xlUp).Select If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1 ActiveCell.Offset(1, 0).Select ActiveCell.Value = ser ActiveCell.Offset(0, 1).Value = S_AMOUNT39 ActiveCell.Offset(0, 2).Value = S_AMOUNT40 ActiveCell.Offset(0, 5).Value = S_explain20 ActiveCell.Offset(0, 6).Value = S_DATE ActiveCell.Offset(0, 7).Value = S_KIND ActiveCell.Offset(0, 8).Value = S_SER ActiveCell.Offset(0, 9).Value = S_NAME19 '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& MsgBox prompt:=" &Ecirc;&atilde; &Ccedil;&aacute;&Ecirc;&Ntilde;&Iacute;&iacute;&aacute; &Egrave;&auml;&Igrave;&Ccedil;&Iacute; &aelig; &Ccedil;&aacute;&Iacute;&atilde;&Iuml; &aacute;&aacute;&aring; ", Title:=" &Ccedil;&aacute;&Iacute;&atilde;&Iuml; &aacute;&aacute;&aring; &Ntilde;&Egrave; &Ccedil;&aacute;&Uacute;&Ccedil;&aacute;&atilde;&iacute;&auml; " MsgBox prompt:=" &Uacute;&aacute;&iacute;&szlig; &atilde;&Ntilde;&Ccedil;&Igrave;&Uacute;&Eacute; &Ccedil;&aacute;&THORN;&iacute;&atilde; &aelig; &Ccedil;&aacute;&Ecirc;&Ocirc;&iacute;&iacute;&szlig; &Uacute;&igrave; &Ccedil;&aacute;&atilde;&aacute;&Yacute;&Ccedil;&Ecirc; ", Title:=" &Ccedil;&Ocirc;&szlig;&Ntilde; &Ccedil;&aacute;&aacute;&aring; " B = MsgBox(" &aring;&aacute; &Ecirc;&Ntilde;&iacute;&Iuml; &Atilde;&auml; &Ecirc;&otilde;&Igrave;&Ntilde;&iacute;&oacute; &Atilde;&iacute; &Uacute;&atilde;&aacute;&iacute;&Eacute; &Atilde;&Icirc;&Ntilde;&igrave; &iquest;&iquest;&iquest;&iquest;&iquest;&iquest; ", vbOKCancel + vbQuestion + vbMsgBoxRight, " &Icirc;&iacute;&Ccedil;&Ntilde;&Ccedil;&Ecirc; ") If B = vbOK Then GoTo 5 If B = vbNo Then GoTo 4 4 ActiveWorkbook.Close SaveChanges:=True Windows("1.xls").Activate ActiveWorkbook.Close SaveChanges:=True 5 Windows("1.xls").Activate Range("A1").Select End Sub حسب الكود لدينا 20 حساب .. و إذا لم تدخل بياناتهم كلهم في ورقة القيد فإن المايكرو سيتوقف لأن العشرين حساب غير متوفرين .. طبعا أنا أحيانا قد أجري قيود على حسابين أو 4 مثلا.. ف بالطبع سيتوقف المايكرو.. هل من حل ؟ استاذ طارق: كيف أكتب في الكود دليل معين مثل: أريد أرحل هذا السند مثلا لـ نفس المجلد الحالي و لكن هذا السند داخل مجلد داخل مجلد مثلا: \Only\ACCOUNTS\ARCHIVES\QS" و الملف الذي أريد يترحل لداخله إسمه مثلا: B1.XLS

السلام عليكم لله أنت أستاذنا طارق.. على مساعدتك.. لكن للأسف الملف الذي ارسلته لا يحل مشكلتي في الترحيل .. عموما لا مشكلة أنا سأدخل بنفسي كل الإدخالات في المايكرو ولو كانت 240 :) لكن المشكلة الان عندي هي أن أكواد الترحيل فيها 20 عميل يتم الترحيل لحساباتهم .. و هذا يعني وجوب أن يكون القيد مشتملا على 20 حساب ..و إلا يتوقف المايكرو بمعنى: لو أني أريد ان اعمل قيود على 3 حسابات فقط ..فإن الترحيل سيتوقف لأن الـ 20 حساب غير مكتملة بياناتهم.. فهل هناك أمر معين يُضاف في المايكرو بحيث يقال له: لا يجب أن ترحل الحسابات الغير مسجلة في ورقة القيود بغض النظر عن وجود عدد 20 حساب هنا في المايكرو.. و جزاك الله خيرا طبعا لم يعمل الترقيم عندي على الشكل الذي كتبته أنت لي .. فأنا أكتب في المايكرو الكود التالي: n_ser = n_ser + 1 Range("E2").Value = "M1-2010- " & 1429 + n_ser و النتيجة في الترحيل الأول في الخلية E2 هي :M1-2010- 1430 أما بالنسبة لكود المراجعة فكذلك لم يعمل.. عموما أنا و الله أستحي من كثر طلباتي .. لكن ما باليد حيلة ... الله يوفقنا و إياك

جزاك الله خيرا استاذي طارق.. و مجهودك كبير علي و الله .. و لك لا أملك لك إلا الدعاء و أرفقت ملف القيود للمشاهدة قيود.rar

جزاك الله خيرا استاذ طارق.. و أرفقت لك نموذج من القيود

مشكور أستاذنا طارق ع تعاونك معي و بارك الله لك في علمك.. الحمد لله زالت مشكلة تعليق الملف..بقي : **** تعديل الرقم التسلسلي يزيد رقم واحد فقط و لا يتعداه .. **** كود المراجعة -بعد التعديل- كذلك لا يعمل يتوقف الترحيل ولا يستجيب. ****ورقة القيودفيها مشكلة استاذي طارق.. المشكلة مش في منع المستخدم من اذدواجية القيد في أن واحد .. المشكلة عندما يكون معي 20 قيد في ورقة واحدة هذا يعني أني أحتاج أدخل في المويل (في المايكرو) فوق 240 إدخال أو أكثر ,,,, تخيل لما أدخل : إسم العميل (المدين) و رقمه و الشرح و الملاحظة و التاريخ و رقم السند و كذلك الطرف الآخر الدائن ... نفس الإدخالات و هذا كله مضروبا في 20 .. تخيل !!!!! بيكون جدا مرهق .هذا طبعا ليس ذنبك أستاذي حاشاك لكن أتسائل هل يوجد كود يختصر هذه الخطوات الطويلة ؟ و بارك الله فيك