دالة نقل القائمة النشط من 2020 الى 2021

[Abhsaid]

قائمة العمال.xlsx

[lionheart]

Sub Test()
    Dim w1 As Worksheet, w2 As Worksheet, c As Range, n As Long
    Set w1 = Sheets("2020"): Set w2 = Sheets("2021")
    n = w2.Cells(Rows.Count, 1).End(xlUp).Row + 1
    For Each c In w1.Range("A5").CurrentRegion.Columns(5).Cells
        If c.Value = "Active" Then
            w2.Range("A" & n).Resize(1, 5).Value = c.Offset(, -4).Resize(1, 5).Value
            n = n + 1
        End If
    Next c
End Sub