طلب كود ترحيل من شيت لأخر

[ياسر أحمد الشيخ]

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

عندى ملف يوميات وهناك زرين للترحيل

أريدأن يقوم كل زر بترحيل جزء من العمالة

ويقوم برتحيل عدد ساعات عمل كل عامل حسب التاريخ

ويقوم بترحيله لشيت Data_entry

attendance.rar

[ياسر أحمد الشيخ]

للرفع

[طارق محمود]

السلام عليكم

أخي العزيز

تقول

لا أريد اجراء أى تعديلات على شكل الملف

وجدت بعض الأشياء البسيطة عدلتها لك ستجدها بالأحمر ولون الخلية أصفر

في شييت المطلوب: الخلية C51 كان بها الوظيفة عامل وغيرته لـ فنى

في شييت Data_Entry: خلية أخري كان بها عمالة فنية وغيرتها لـ عمالة عادية

تفضل المرفق

attendance_TAREQ.rar

[ياسر أحمد الشيخ]

حل رائع جدا

ولكن اذا تكرمت أخى الكريم

اريد أن توضح لى كيف أعدل على هذا الكود حيث أريد زيادة النطاق فى كلاً من الشيتين

وشكرا

[طارق محمود]

السلام عليكم

اريد أن توضح لى كيف أعدل على هذا الكود حيث أريد زيادة النطاق فى كلاً من الشيتين

إن كنت تقصد عدد العمال

(1) في شيت (Data_Entry)

____(أ) في كود shift_Biomass

........

c = WorksheetFunction.Match(a, .Range("C4:AH4"), 0) + 2

    For r1 = 3 To LastRow

	    For r2 = 5 To 61

............

تغير الرقم 61 والذي يعبر عن آخر الصف الذي به آخر عامل بالبيوماس ____(ب) في كود shift_Shredders

........


c = WorksheetFunction.Match(a, .Range("C66:AH66"), 0) + 2

    For r1 = 39 To LastRow

	    For r2 = 67 To 125

............

تغير الرقمين 67 ، 125 والذي يعبران عن أول و آخر الصف به عمال المفارم (2) في شيت (المطلوب) كود shift_Biomass لاتغيير كود shift_Shredders تغيير طفيف

Sub shift_Shredders() On Error Resume Next a = Day([D37]) LastRow = [b38].End(xlDown).Row With Sheets("Data_Entry") c = WorksheetFunction.Match(a, .Range("C66:AH66"), 0) + 2 For r1 = 39 To LastRow

الرقم 39 هذا الأخير يستبدل برقم الصف الذي تبدأ منه أول عمل في المفارم في شيت (المطلوب) أما إن كنت تقصد عدد الأيام وهي موجودة حاليا في الصف الرابع في المجال C4:AH4 لنفرض انها أصبحت تصل إلي العمود BX مثلا فتستبدل كل AH4 في الكود إلي BX4 وبالنسبة لمسح الخلايا آخر جزء في كلا الكودين

.....

If Response <> vbYes Then Exit Sub

Range("D1,D3:D33,I3:I33").ClearContents

'===========================================

On Error GoTo 0

End Sub

هذا المجال أو المجالات

"D1,D3:D33,I3:I33"

هي التي تتغير في الورقة (المطلوب)

فلتغيرها حسب التعديلات

[ياسر أحمد الشيخ]

شكرا أخى طارق

شرح موفق