ahmedhafez قام بنشر مارس 22, 2009 مشاركة قام بنشر مارس 22, 2009 (معدل) السلام علييكم عمالقة المنتدى ارجو المساعجة انا شاهدت الكثير من الاكواد والمعادلات فارجو من يوجد عندة الحل لا يبخل ويجعلة فى ميزان حسناتة ولا يسعنى سوى الدعاء لة الموضوع كل ما اريدة هو ياخد نسخة من الثلات اعمدة الموجودة فى كل شيت ويضعهم بالترتيب فى الشيت المسمى توتال فقط لاغير بدلا من الذهاب الى كل صفحة وعمل كوبى وبست فى التوتال لانى اعمل هذا الكلام كل شهر وفى بعض الاحيان يتم وضع صفر هل من الممكن اخذة مع الاعتار احيانا تاتى ايام فارغة ولا اضع فيها شيئا اريد ان ياخد اليوم الفارغ ويضع صفر Feb_09.rar تم تعديل مارس 22, 2009 بواسطه ahmedhafez رابط هذا التعليق شارك More sharing options...
طارق محمود قام بنشر مارس 22, 2009 مشاركة قام بنشر مارس 22, 2009 السلام عليكم جرب هذا الكود Sub sheet_collec() x = Worksheets.Count Worksheets(2).Select For i = 2 To x Worksheets(i).Select Range("A2", ActiveCell.SpecialCells(xlLastCell)).Select Selection.Copy rr = Selection.Rows.Count sh = Worksheets(i).Name Range("A2").Select Worksheets(1).Select ActiveCell.SpecialCells(xlLastCell).Select ActiveCell.Offset(1, 0).Select Selection.End(xlToLeft).Select ActiveSheet.Paste For j = 1 To rr ActiveCell.Offset(j - 1, 3).Value = sh Next j Next i End Sub كما بالمرفق يحتاج تعديل بسيط أستأذن أحد الأخوة لتحسينه حيث أنني غير متمكن في الأكواد تحياتي ______________________2.rar رابط هذا التعليق شارك More sharing options...
ahmedhafez قام بنشر مارس 22, 2009 الكاتب مشاركة قام بنشر مارس 22, 2009 لم يفلح هذا الكود يا اخى الكريم يحتاج الى تحسين هل من مساعد من مبرمجى وعمالقة الاكسل رابط هذا التعليق شارك More sharing options...
ميدو63 قام بنشر مارس 22, 2009 مشاركة قام بنشر مارس 22, 2009 للرفعحتى نجد حلا رابط هذا التعليق شارك More sharing options...
ahmedhafez قام بنشر مارس 22, 2009 الكاتب مشاركة قام بنشر مارس 22, 2009 (معدل) اخى الكريم اخوانى فى هذا المنتدى العملاق الكود فقط يحتاج الى ظبط وهو يعمل ولاكن النتيجة انى اريد فقط ثلات اعمدة وليس كل الشيت فارجو المساعدة فى ظبطة فقط T.CHECK NO و S/SLIP - PRESITGE و Payable -Prestige واشكر اخى الكريم واضع الكود واشكرة على المساعدة وجزاة اللة كل خير تم تعديل مارس 22, 2009 بواسطه ahmedhafez رابط هذا التعليق شارك More sharing options...
طارق محمود قام بنشر مارس 22, 2009 مشاركة قام بنشر مارس 22, 2009 السلام عليكم أضفت لك الكود الآتي للسابق Range("E2").Select ActiveCell.FormulaR1C1 = "=COUNTA(RC[-4]:RC[-2])" Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.FillDown Rows("1:1").Select Selection.AutoFilter Range("E1").Select Selection.AutoFilter Field:=5, Criteria1:="0" Range("E14").Select Range(Selection, Selection.End(xlDown)).Select Rows("14:69").Select Range("E14").Activate Selection.Delete Shift:=xlUp Selection.AutoFilter Range("B2").Select ActiveWorkbook.Save جرب المرفق مباشرة وإن شاء الله يكون هو المطلوب ______________________3.rar رابط هذا التعليق شارك More sharing options...
عادل حنفي قام بنشر مارس 22, 2009 مشاركة قام بنشر مارس 22, 2009 السلام عليكم و بعد اذن اخي طارق جرب الملف المرفق هذا حسب ما فهمت من طلبك تحياتي Feb_09.rar رابط هذا التعليق شارك More sharing options...
احمدزمان قام بنشر مارس 22, 2009 مشاركة قام بنشر مارس 22, 2009 السلام عليكم و رحمة الله استاذ طارق محمود شكرا جزيلا لك فكرة الكود جميلة استاذي عادل بعد اذنك انا عملت على الملف الأخ احمد حافظ بناء على رسالتك تم عمل المرفق ______________________2.rar رابط هذا التعليق شارك More sharing options...
ahmedhafez قام بنشر مارس 23, 2009 الكاتب مشاركة قام بنشر مارس 23, 2009 (معدل) جزاكم الله خيرا وجعلة فى ميزان حسناتكم ولاكن اخى احمد يعقوب بعد اذنك انا يوجد سوالين اذا اردت ان اقوم باستخراج الاعمدة المظللة بالون الاصفر فقط وهى العمود b و العمود f و العمود g فهل من الممكن تدلنى على كيفية التعديل فى الكود لانة سوف يفيدونى فى اشياء كثيرة وهل ممكن ان اختار عدد الصفوف فى كل شيت واخر شىء بعد اذنك اخى الكريم يوجد صفوف تحتوى على صفر فهل من الممكن ان عند تنفيذ الكود ان يقوم باستبعاد الخلايا التى تحتوى على صفر واريد ان اشكركم اخوانى وجزاكم الله كل خير يا اخى طارق واخى عادلوان لم يمكن اخر الكريم عمل ماطلبت اريد فقط توضيع ان يعيد الكود من العمود B الى G وشرح الطريقة لاخيار ارجاع الاعمدة التى اريدها للتطبيق على شيتات اخرى بنفس الفكرة وهل ينفع هذا الكود لو اردت ارجاع مثلا العمود B والعمود واخر عمود على سبيل المثال تم تعديل مارس 23, 2009 بواسطه ahmedhafez رابط هذا التعليق شارك More sharing options...
احمدزمان قام بنشر مارس 23, 2009 مشاركة قام بنشر مارس 23, 2009 اخي اقرأ هذا الموضوع لتفهم عمل هذا الكود http://www.officena.net/ib/index.php?s=&am...st&p=130251 وكل ما ذكرته من تعديلات ممكنه اذا فهمت الموضوع الذي على الرابط السابق رابط هذا التعليق شارك More sharing options...
ahmedhafez قام بنشر مارس 23, 2009 الكاتب مشاركة قام بنشر مارس 23, 2009 جزاك الله كل خير اخى احمد يعقوب ولاكن لو لديك وقت هل من اللممكن جعل الكود يستخرج فقط الثلاث اعمدة b و f و g رابط هذا التعليق شارك More sharing options...
احمدزمان قام بنشر مارس 23, 2009 مشاركة قام بنشر مارس 23, 2009 Sub sheet_collec() Dim x 'ÚÏÏ ÇáÃæÑÇÞ Dim Z ' Dim A 'ÂÎÑ ÕÝ ááæÑÞÉ ÇáãÑÍá ãäåÇ Dim S 'ÂÎÑ ÕÝ ááæÑÞÉ ÇáãÑÍá áåÇ Sheets("TOTAL").Select S = Range("A55555").End(xlUp).Row x = Worksheets.Count Worksheets(2).Select For i = 2 To Sheets.Count Worksheets(i).Select sh = Worksheets(i).Name For A = 2 To Range("A9999").End(xlUp).Row With Sheets("TOTAL") Let S = S + 1 .Cells(S, 1) = Cells(A, 2) .Cells(S, 2) = Cells(A, 6) .Cells(S, 3) = Cells(A, 7) .Cells(S, 4) = sh End With Next A Next i Worksheets(1).Select End Sub نفضل اخي الفاضل رابط هذا التعليق شارك More sharing options...
ahmedhafez قام بنشر مارس 23, 2009 الكاتب مشاركة قام بنشر مارس 23, 2009 اخى احمد جزاك الله كل خير ولاكن لايعمل ويعطى رسالة خطا ارجو تطبيقة على المرفق وشاكر مساعدتك وجعلها الله فى ميزان حسناتك اخى الكريم Feb_09.rar رابط هذا التعليق شارك More sharing options...
ابو اسامة العينبوسي قام بنشر مارس 23, 2009 مشاركة قام بنشر مارس 23, 2009 (معدل) السلام عليكم Sub sheet_collec() For i = 1 To Sheets.Count - 1 Worksheets("" & i).Select T = 3 Do While T < ActiveSheet.UsedRange.Rows.Count + 1 R1 = Sheets("total").Cells(65000, 1).End(xlUp).Row + 1 Sheets("total").Cells(R1, 1) = ActiveSheet.Cells(T, 2) If ActiveSheet.Cells(T, 6) = "" Then Sheets("total").Cells(R1, 2) = 0 Else Sheets("total").Cells(R1, 2) = ActiveSheet.Cells(T, 6) End If If ActiveSheet.Cells(T, 7) = "" Then Sheets("total").Cells(R1, 3) = 0 Else Sheets("total").Cells(R1, 3) = ActiveSheet.Cells(T, 7) End If T = T + 1 Loop Application.StatusBar = "يتم الان ترحيل الورقة" & ActiveSheet.Name Next i Sheets("total").Select End Sub [code] كود اخر [code] Sub sheet_collect2() TR = 2 For i = 1 To Sheets.Count - 1 Worksheets("" & i).Select For x = TR To ActiveSheet.UsedRange.Rows.Count R1 = Sheets("total").Cells(65000, 1).End(xlUp).Row + 1 Sheets("total").Cells(R1, 1) = ActiveSheet.Cells(x, 1) Next x Next i End Sub my_Opinion.rar تم تعديل مارس 23, 2009 بواسطه ابو اسامة العينبوسي رابط هذا التعليق شارك More sharing options...
ahmedhafez قام بنشر مارس 23, 2009 الكاتب مشاركة قام بنشر مارس 23, 2009 (معدل) جزاك الله خير اخى ابو اسامة واخى احمد يعقوب وهو يعمل الان ولاكن لو امكن توضيح كيف يمك التعديل فى الكود لاختيار الاعمدة واشكر كل من ساعد فى هذا الموضوع وجعلة فى ميزان حسناتكم ان شاء الله ارجو من الاخ اسامة اذا امكن التوضيح كيفية التعديل فى الكود لتغير واخيار اعمدة اخر على سيبل المتال كل شيت يحتوى على 10 اعمدة كيف اختار 5 او كيف اختار 2 وكيف اختار اعمدة متباعدة واعمدة متاتلية تم تعديل مارس 23, 2009 بواسطه ahmedhafez رابط هذا التعليق شارك More sharing options...
الشيباني1 قام بنشر مارس 23, 2009 مشاركة قام بنشر مارس 23, 2009 اخواني الاعزاء تحية طيبه ملاحظة بسيطه على عمل الكود وهي عند الضغط على الزر (collect) يتكرر ترحيل البيانات السابقه اضافة للجديده ، موضوع رائع ويخدم عمل الكثيرين مع الامتنان رابط هذا التعليق شارك More sharing options...
ابو اسامة العينبوسي قام بنشر مارس 23, 2009 مشاركة قام بنشر مارس 23, 2009 الاخ tofimoon ممكن تضع الاتى Range(Cells(3, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count)).ClearContents اما تضعه في الموديل او تضيفه الى زر الامر Collect رابط هذا التعليق شارك More sharing options...
الشيباني1 قام بنشر مارس 23, 2009 مشاركة قام بنشر مارس 23, 2009 الاستاذ ابو اسامه المحترم مع تقديري هل بالامكان تنفيذ الاضافة على المثال لتكون الصورة اوضح واشمل مع الشكر رابط هذا التعليق شارك More sharing options...
ابو اسامة العينبوسي قام بنشر مارس 23, 2009 مشاركة قام بنشر مارس 23, 2009 السلام عليكم ردودى تكو ن على عجل لانى اكون في العمل لوحدى لذلك تكون بحاجه الى تنقيح هنا الكود معدل و اسرع my_Opinion2.rar رابط هذا التعليق شارك More sharing options...
ahmedhafez قام بنشر مارس 24, 2009 الكاتب مشاركة قام بنشر مارس 24, 2009 جزاك الله كل خير اخى الكريم رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.