ترحيل الطلبة حسب التخصص

[kinguter1]

اساتذتنا / خبراء الاكسيل

ارجو المساعدة فى تعديل الكود الموجود بالملف الرفق ليعمل الأتى

1- اضافة شيت يحمل كود التخصص فى حالة عدم وجود شيت للتخصص

2- ترحيل بينانات الطلبة حسب كود التخصص لكل طلب 

3- مسح البيانات من شيت التخصص قبل الترحيل اليه

4- عدم التقيد بمكان الشيت المصدر بين الشيتات

5- نقل قيم البيانات وتنسيقاتها بدون المعادلات

studenT.rar

[احمدزمان]

السلام عليكم و رحمة الله وبركاته

 

وجدت كود ترحيل موجود من السابق في الملف

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

لاادري

هل هو يعمل وتريد التعديل علية

او

غير ذلك

[kinguter1]

السلام عليكم

الكود الموجود لا بعطى النتيجة المطلوبة حيث أن الترحيل لا يتم على كافة الطلبة 

ولو حضرتك جربت الكود سوق تجد النتيجة مش مضبوطة

هذا هو الطلب رقم 2

تم تعديل أغسطس 25, 2014 بواسطه kinguter1

[احمدزمان]

السلام عليكم و رحمة الله وبركاته

 

تم العمل على الملف كما فهمت من طلبك

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

[kinguter1]

استاذنا الفاضل / احمد

السلام عليكم ورحمة الله وبركاته

اشكرك شكرأً جزيلاً على لاهتمام بموضوعى ولكن ارجوا قراءة الخمس طلبات فى الموضوع الأصلى لأن 

1- التعدبل يقوم بمسح البيانات من الشيت المصدر وهذا غبر مطلوب

2- يجب مسح البيانات الموجودة من الشيتات المرحل إليها قبل ترحيل البيانات الجديدة

3- يجب وضع البيانات المرحلة بداية من الخلية c2

[احمدزمان]

وعليكم السلام و رحمة الله وبركاته

 

علم

ان شاء الله يكون ما تريد

[احمدزمان]

السلام عليكم و رحمة الله

 

تم اضافة زر اعلى الورقة يقوم بمسح البيانات القديمة بدون ترحيل

الأوراق التي اسمها رقم و ليس نص

 

studenT.rar

[kinguter1]

استاذى العزيز / احمد

اشكر لك المجهود الذى قمت به وارجو تعديل بسيط

1- زر المسح يقوم بالمسح من a2 ( والمطلوب ان يتم المسح من c2 )

2- يجب أن يتم اللصق ابتداء من c2

[احمدزمان]

السلام عليكم و رحمة الله وبركاته

 

تفضل

studenT.rar

[kinguter1]

استاذى العزيز / أحمد

السلام عليكم ورحمة الله وبركاته

ارجو أن تفيض علينا بكرمك وتوضح شرح وظيفة كل سطر فى كود المسح والترحيل نستفيد من هذا المجهود الرائع

وأرجو أيضا أن أعرف وظيفة هذا السطر

Sub DDEE()

Range(Cells(1, 1), Cells(2, 2)).Select

 

End Sub

[احمدزمان]

 

وأرجو أيضا أن أعرف وظيفة هذا السطر

Sub DDEE()

Range(Cells(1, 1), Cells(2, 2)).Select

 

End Sub

 

 

هذه مجرد تجربة اثناء العمل

ليس لها اي دخل بالكود