ترحيل بعض الخلايا الى شيت خلاصة الرواتب الشهرية

[ابو عبدالرحمن البغدادي]

السلام عليكم - حياكم الله

وفقكم الله : ممكن ترحيل البيانات الموضحة باللون الاحمر في شيت البيانات الى شيت خلاصة الرواتب الشهرية ، وكما مبين بالملف المرفق

ترحيل البيانات الى شيت خلاصة الرواتب الشهرية.rar

[خالد الرشيدى]

السلام عليكم

جرب الكود التالى عله يفى بالمطلوب

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

 

تم تعديل نوفمبر 17, 2015 بواسطه خالد الرشيدى

[ابو عبدالرحمن البغدادي]

السلام عليكم - حياكم الله

تمام - كود روعة - جزيت خيرا