السلام عليكم
جرب الكود التالى عله يفى بالمطلوب
Sub Button1_Click()
Dim r As Range, e As Range, n%, LaRw@
With Application
.ScreenUpdating = False: .EnableEvents = False: .Calculation = xlCalculationManual
End With
For Each r In æÑÞÉ1.Range(Range("A4"), Range("A4").End(xlDown))
n = WorksheetFunction.Match(r.Offset(0, 15), æÑÞÉ2.Range("A1:Zz1").Value, 0)
Set e = æÑÞÉ2.Columns(n).Find(what:=r, LookIn:=xlValues, lookat:=xlWhole)
If e Is Nothing Then
LaRw = æÑÞÉ2.Cells(Rows.Count, n).End(xlUp).Row + 1
r.Range("a1:b1,n1:p1").Copy æÑÞÉ2.Cells(LaRw, n)
End If
Next
With Application
.ScreenUpdating = True: .EnableEvents = True: .Calculation = xlCalculationAutomatic
End With
End Sub
ترحيل البيانات الى شيت خلاصة الرواتب الشهرية_2.rar