kinguter1 قام بنشر أغسطس 23, 2014 مشاركة قام بنشر أغسطس 23, 2014 اساتذتنا / خبراء الاكسيل ارجو المساعدة فى تعديل الكود الموجود بالملف الرفق ليعمل الأتى 1- اضافة شيت يحمل كود التخصص فى حالة عدم وجود شيت للتخصص 2- ترحيل بينانات الطلبة حسب كود التخصص لكل طلب 3- مسح البيانات من شيت التخصص قبل الترحيل اليه 4- عدم التقيد بمكان الشيت المصدر بين الشيتات 5- نقل قيم البيانات وتنسيقاتها بدون المعادلات studenT.rar رابط هذا التعليق شارك More sharing options...
احمدزمان قام بنشر أغسطس 24, 2014 مشاركة قام بنشر أغسطس 24, 2014 السلام عليكم و رحمة الله وبركاته وجدت كود ترحيل موجود من السابق في الملف Sub trheel() 'ÊÑÍíá ÇáØáÈÉ ÍÓÈ ÇáÊÎÕÕ ' trheel Macro ' ' Application.ScreenUpdating = False Dim SH As Worksheet For Each SH In ThisWorkbook.Worksheets For r = 26 To 2000 If SH.Name = "ÇáãáÝÇÊ" Then GoTo 2 If Cells(r, 9).Value <> Empty Then If Cells(r, 9).Value = SH.Name Then Range(Cells(r, 11), Cells(r, 49)).Copy QQ = SH.Cells(1000, 3).End(xlUp).Row + 1 SH.Range("c" & QQ).PasteSpecial xlPasteValues End If End If Next 2 Next Application.CutCopyMode = False Application.ScreenUpdating = True End Sub لاادري هل هو يعمل وتريد التعديل علية او غير ذلك رابط هذا التعليق شارك More sharing options...
kinguter1 قام بنشر أغسطس 25, 2014 الكاتب مشاركة قام بنشر أغسطس 25, 2014 (معدل) السلام عليكم الكود الموجود لا بعطى النتيجة المطلوبة حيث أن الترحيل لا يتم على كافة الطلبة ولو حضرتك جربت الكود سوق تجد النتيجة مش مضبوطة هذا هو الطلب رقم 2 تم تعديل أغسطس 25, 2014 بواسطه kinguter1 رابط هذا التعليق شارك More sharing options...
احمدزمان قام بنشر أغسطس 25, 2014 مشاركة قام بنشر أغسطس 25, 2014 السلام عليكم و رحمة الله وبركاته تم العمل على الملف كما فهمت من طلبك Sub trheel() 'ÊÑÍíá ÇáØáÈÉ ÍÓÈ ÇáÊÎÕÕ ' trheel Macro ' Application.ScreenUpdating = False Dim SH As Worksheet, RN1 As Range, CC As Range Dim ER, FR, TR, TS, TSS Set SH = Sheets("ÇáãáÝÇÊ") ER = SH.UsedRange.Rows.Count For FR = 26 To ER If SH.Range("I" & FR) = "" Then GoTo 9 Set RN1 = SH.Range("I" & FR & ":AW" & FR) TS = SH.Range("I" & FR).Text For TSS = 2 To Sheets.Count If Sheets(TSS).Name <> TS Then GoTo 8 TR = Sheets(TS).Cells(9999, 2).End(xlUp).Row + 1 RN1.Copy Sheets(TS).Range("A" & TR).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False For Each CC In RN1 If CC.HasFormula = True Then GoTo 7 CC.ClearContents 7 Next CC 8 Next TSS 9 Next FR Application.CutCopyMode = False Application.ScreenUpdating = True End Sub student--AYMZ.rar رابط هذا التعليق شارك More sharing options...
kinguter1 قام بنشر أغسطس 25, 2014 الكاتب مشاركة قام بنشر أغسطس 25, 2014 استاذنا الفاضل / احمد السلام عليكم ورحمة الله وبركاته اشكرك شكرأً جزيلاً على لاهتمام بموضوعى ولكن ارجوا قراءة الخمس طلبات فى الموضوع الأصلى لأن 1- التعدبل يقوم بمسح البيانات من الشيت المصدر وهذا غبر مطلوب 2- يجب مسح البيانات الموجودة من الشيتات المرحل إليها قبل ترحيل البيانات الجديدة 3- يجب وضع البيانات المرحلة بداية من الخلية c2 رابط هذا التعليق شارك More sharing options...
احمدزمان قام بنشر أغسطس 25, 2014 مشاركة قام بنشر أغسطس 25, 2014 وعليكم السلام و رحمة الله وبركاته علم ان شاء الله يكون ما تريد رابط هذا التعليق شارك More sharing options...
احمدزمان قام بنشر أغسطس 25, 2014 مشاركة قام بنشر أغسطس 25, 2014 السلام عليكم و رحمة الله تم اضافة زر اعلى الورقة يقوم بمسح البيانات القديمة بدون ترحيل الأوراق التي اسمها رقم و ليس نص studenT.rar رابط هذا التعليق شارك More sharing options...
kinguter1 قام بنشر أغسطس 26, 2014 الكاتب مشاركة قام بنشر أغسطس 26, 2014 استاذى العزيز / احمد اشكر لك المجهود الذى قمت به وارجو تعديل بسيط 1- زر المسح يقوم بالمسح من a2 ( والمطلوب ان يتم المسح من c2 ) 2- يجب أن يتم اللصق ابتداء من c2 رابط هذا التعليق شارك More sharing options...
احمدزمان قام بنشر أغسطس 26, 2014 مشاركة قام بنشر أغسطس 26, 2014 السلام عليكم و رحمة الله وبركاته تفضل studenT.rar رابط هذا التعليق شارك More sharing options...
kinguter1 قام بنشر أغسطس 27, 2014 الكاتب مشاركة قام بنشر أغسطس 27, 2014 استاذى العزيز / أحمد السلام عليكم ورحمة الله وبركاته ارجو أن تفيض علينا بكرمك وتوضح شرح وظيفة كل سطر فى كود المسح والترحيل نستفيد من هذا المجهود الرائع وأرجو أيضا أن أعرف وظيفة هذا السطر Sub DDEE() Range(Cells(1, 1), Cells(2, 2)).Select End Sub رابط هذا التعليق شارك More sharing options...
احمدزمان قام بنشر أغسطس 27, 2014 مشاركة قام بنشر أغسطس 27, 2014 وأرجو أيضا أن أعرف وظيفة هذا السطر Sub DDEE() Range(Cells(1, 1), Cells(2, 2)).Select End Sub هذه مجرد تجربة اثناء العمل ليس لها اي دخل بالكود رابط هذا التعليق شارك 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.