Macro has long runningtime

Hello Everyone.

I am using the following macro to add information of active assignments to a new sheet. HOWEVER the macro takes more then 15 seconds to run. Is there any way of shortening this?


I appreciate any help. Thanks in Advance

Cheers,

Mads

Sub AddActive()


            
    Dim Rng As Range
       Dim i As Long

    'Looping range
    Set Rng = Sheets("WorkingSheet").Range("AA11:AA1008")
    
    For Each cell In Rng
    

           If cell.value = "NO" Then
           
            'write to adjacent cell
            Sheets("Overview").Range("A35:A1000").End(xlDown).Offset(1, 0) = cell.Offset(0, -24).value
            Sheets("Overview").Range("A35:A1000").End(xlDown).Offset(0, 1) = cell.Offset(0, -23).value
            Sheets("Overview").Range("A35:A1000").End(xlDown).Offset(0, 2) = cell.Offset(0, -22).value
            Sheets("Overview").Range("A35:A1000").End(xlDown).Offset(0, 3) = cell.Offset(0, -21).value
            Sheets("Overview").Range("A35:A1000").End(xlDown).Offset(0, 4) = cell.Offset(0, -20).value
            Sheets("Overview").Range("A35:A1000").End(xlDown).Offset(0, 5) = cell.Offset(0, -18).value
            
                                  
            
            
        End If
    Next
End Sub