طلب كود ترحيل بدلالة صف وعنوان عمود

[فريدة العصر]

الرجاء من أساتذة المنتدى المساعدة بكود ترحيل حسب اسم العامل وعمود يوم المبيت فى صفحة 1يوجد اسماء العمال وأمام كل منهم يوم المبيت والمطلوب كود بترحيل وكتابة كلمة مبيت فى جدول الاسماء وايام الاسبوع بصفحة 2 حسب اليوم المحدد بصفحة 1

المصنف 1.xlsx

[ابراهيم الحداد]

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

استخدم هذا الكود

Sub Work_Day()
Dim ws As Worksheet, Sh As Worksheet
Dim C As Range, LR As Long, i As Long
Dim x As Integer, Dy As String
Dim WF As Object
Set ws = Sheets("ورقة2")
Set Sh = Sheets("ورقة1")
Set WF = WorksheetFunction
LR = ws.Range("A" & Rows.Count).End(3).Row
i = 2
Do While i <= LR
For Each C In Sh.Range("A2:A" & ws.Range("A" & Rows.Count).End(3).Row)
If ws.Cells(i, 1) = C.Value Then
Dy = C.Offset(0, 1)
x = WF.Match(Dy, ws.Range("B1:G1"), 0)
ws.Cells(i, 1).Offset(0, x) = Dy
End If
Next
i = i + 1
Loop
End Sub

 

[عبدالفتاح في بي اكسيل]

اذا كانت بياناتك قليلة   فاستخدم  معادلة  المصفوفة  بالضغط ctrl+shift+enter

=IF(ISNUMBER(MATCH($A4&C$1,sheet1!$A$1:$A$7&sheet1!$B$1:$B$7,0)),"يوم المبيت","")

اما اذا  اردت  كود  فلا حاجة  للحلقات التكرارية 

Sub ctr()
With Range("B2:G6")
    .Formula = "=IF(ISNUMBER(MATCH($A2&B$1,SHEET1!$A$1:$A$7&SHEET1!$B$1:$B$7,0)),""يوم المبيت"","""")"
    .FormulaArray = .FormulaR1C1
    .Formula=.value
End With
End Sub

 

[فريدة العصر]

شااااكر حضراتكم وربنا يبارك فى عملكم وعلمكم