نقل المعلومات من صفحة ل أخرى بشروط

[kel1110]

ارجو المساعدة أريد نقل بيانات من صفحة محددة بالقيم المقابلة للأسم بحيث الأسم موجود في في صفحة محددة ..

الرواتب.rar

[رجب جاويش]

أخى الفاضل

جرب هذا الكود

Sub ragab()

Dim cl As Range, cll As Range, cel As Range

LR = [B1000].End(xlUp).Row

Application.ScreenUpdating = False

Set rng1 = Sheets("warehouse").Range("A5:A48")

Set rng2 = Sheets("Main Branch").Range("A5:A19")

For Each cl In Range("B2:B" & LR)

    For Each cll In rng1

	    If cl = cll Then

		    cll.Offset(0, 8) = cl.Offset(0, 1)

	    End If

    Next

Next

For Each cl In Range("B2:B" & LR)

    For Each cel In rng2

	    If cl = cel Then

		    cel.Offset(0, 8) = cl.Offset(0, 1)

	    End If

    Next

Next

Set rng1 = Nothing

Set rng1 = Nothing

Application.ScreenUpdating = True

End Sub

الرواتب.rar

[رجب جاويش]

وهذا حل آخر بالمعادلات

مع تعديل بسيط فى معادلات العمود M

الرواتب1.rar

[kel1110]

شكرا كتير الطريقتين تمام

[kel1110]

أستاذ رجب شكرا كتير عل الطريقة ناجحة بس أنا مستلم شؤون موظفين جديد وهاد الملف الكامل أذا ممكن تساعدني بتفعيل الكود عل الملف الكامل مع العلم ان عدد الأفرع 10 والمطلوب بالضبط موجود في الصفحة الخاصة بالتأخير وجزاك الله كل خير :fff: :fff: :fff:

التأخير.rar

[رجب جاويش]

أخى الفاضل

أنا تحت أمرك فى أى تعديل

جرب هذا الكود واخبرنى بالنتيجة

Sub ragab()

Dim LR As Integer, sh As Worksheet

Dim cl As Range, cll As Range

Application.ScreenUpdating = False

LR = Cells(Rows.Count, 4).End(xlUp).Row

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

For Each sh In ThisWorkbook.Worksheets

    If Not sh.Name = "الغياب" Then

	    sh.Range("S5:T100").ClearContents

	    For Each cl In sh.Range("A5:A" & [A5].End(xlDown).Row)

		    For Each cll In Range("D2:D" & LR)

			    If cll = cl And cll <> "" Then

				    cl.Offset(0, 18) = cll.Offset(0, 1)

				    cl.Offset(0, 19) = cll.Offset(0, 2)

			    End If

		    Next

	    Next

    End If

Next

Application.ScreenUpdating = False

End Sub

الرواتب1.rar

[رجب جاويش]

وهذا هو الحل بالمعادلات

الرواتب2.rar