التعديل في كود الترحيل

[skyblue]

الاساتذة المشرفين بعد التحية

برجاء التكرم بالتعديل على الملف المرفق .

وهو يخص عملية الترحيل .

حيث انني كنت ومازلت عندما اعمل تلرحيل من صفحة الى اخرى اولا اعمل جدول حسب البيانات المطلوبة ثم اعمل كود الترحيل وهذا الكود كبير جدا وهذه صورة من هذا الكود :

Sub MoveValue2()

Dim EndRow As Long

EndRow = Sheets(2).Range("A1").CurrentRegion.Rows.Count

Sheets(2).Cells(EndRow + 1, 1).Value = EndRow

Sheets(2).Cells(2, 1).Value = Sheets(1).Cells(8, 2).Value

Sheets(2).Cells(2, 2).Value = Sheets(1).Cells(8, 3).Value

Sheets(2).Cells(3, 1).Value = Sheets(1).Cells(9, 2).Value

Sheets(2).Cells(3, 2).Value = Sheets(1).Cells(9, 3).Value

Sheets(2).Cells(4, 1).Value = Sheets(1).Cells(10, 2).Value

Sheets(2).Cells(4, 2).Value = Sheets(1).Cells(10, 3).Value

Sheets(2).Cells(5, 1).Value = Sheets(1).Cells(11, 2).Value

Sheets(2).Cells(5, 2).Value = Sheets(1).Cells(11, 3).Value

Sheets(2).Cells(6, 1).Value = Sheets(1).Cells(12, 2).Value

Sheets(2).Cells(6, 2).Value = Sheets(1).Cells(12, 3).Value

Sheets(2).Cells(7, 1).Value = Sheets(1).Cells(13, 2).Value

Sheets(2).Cells(7, 2).Value = Sheets(1).Cells(13, 3).Value

Sheets(2).Cells(8, 1).Value = Sheets(1).Cells(14, 2).Value

Sheets(2).Cells(8, 2).Value = Sheets(1).Cells(14, 3).Value

Sheets(2).Cells(9, 1).Value = Sheets(1).Cells(15, 2).Value

Sheets(2).Cells(9, 2).Value = Sheets(1).Cells(15, 3).Value

Sheets(2).Cells(10, 1).Value = Sheets(1).Cells(16, 2).Value

Sheets(2).Cells(10, 2).Value = Sheets(1).Cells(16, 3).Value

Sheets(2).Cells(11, 1).Value = Sheets(1).Cells(17, 2).Value

Sheets(2).Cells(11, 2).Value = Sheets(1).Cells(17, 3).Value

Sheets(2).Cells(12, 1).Value = Sheets(1).Cells(18, 2).Value

Sheets(2).Cells(12, 2).Value = Sheets(1).Cells(18, 3).Value

Sheets(2).Cells(13, 1).Value = Sheets(1).Cells(19, 2).Value

Sheets(2).Cells(13, 2).Value = Sheets(1).Cells(19, 3).Value

Sheets(2).Cells(14, 1).Value = Sheets(1).Cells(20, 2).Value

Sheets(2).Cells(14, 2).Value = Sheets(1).Cells(20, 3).Value

Sheets(2).Cells(15, 1).Value = Sheets(1).Cells(21, 2).Value

Sheets(2).Cells(15, 2).Value = Sheets(1).Cells(21, 3).Value

Sheets(2).Cells(16, 1).Value = Sheets(1).Cells(22, 2).Value

Sheets(2).Cells(16, 2).Value = Sheets(1).Cells(22, 3).Value

MsgBox prompt:="Êã ÊÑÍíá ÇáÈíÇäÇÊ ÈäÌÇÍ", Title:="ÑÓÇáÉ ÊÃßíÏ"

Sheets(1).Range("c3, b8:g22, h8:i16, h19:i22").clearcontents

End Sub

ومن عيوب هذا الكود انه محدد لايمكن اي انه لا يرحل الا النطاقات المحددة له بالكود .

بعكس الطريقة التي اريدها فهي مفتوحة ويمكن ان ترحل الشيت بالكامل

لذا أمل التكرم بالتعديل على الملف المرفق ..

تحياتي

[علي السحيب]

شاهد المرفق،

___________________________________.rar

[skyblue]

شكرا لك استاذ علي على الرد .فالمعذرة لاني أخطات في توصيل المعلومة انا كنت اقصد لو تم تعبئة

الصف الخامس بالكامل فبمجرد مااسجل العنوان يظهر لي صف جديد هو الصف رقم 6 وينتقل الموشر الى اول الخلية في الصف السادس ... وبعد مااعبي الصف السادس بالكامل يتم تخليق صف جديد وهكذا .

ايضا لو عملت زر لمسح البيانات وللبدء في عمل جديد هل يتغير شكل الجدول في sheet2

تحياتي لك يااغلى انسان

[علي السحيب]

تم التعديل .. شاهد المرفق،

___________________________________.rar

[skyblue]

ممتاز جدا لكن جميع الاسطر بلون واحد اللي هو الاصفر اذا امكن تكون بلونين كل سطر بلون .

واخيرا اتمنى بس لو تشرح لي الكود لانه نفسي اعرف هذا الكود بالذات .

اخوي على سامحني اذا انا طولت عليك واطلب المعذرة منك .

يحفظك ربي من كل شر