VBA optimize performance for 3 loops - vba

Question

First I wish to check if the value in in each row of column D of "Sheet1" matches any row of column A of "Accepted". If there is a match, I would like to copy the value in column B of that row of "Sheet1" into column D of "Accepted".
However, as there are 2 possible values in column B of "Sheet1", I would like to split the values into two columns of "Accepted" - Columns D and E. Hence, the next loop, if the value in column D of "Accepted" is not "Restricted", then copy that value into Column E and remove content of Column D.
The code works fine in that it helps me to achieve my goal, however, the process is taking too long, and after some investigation I found out that the delay only occurs with the last loop. I was wondering if I could speed up this process, thanks!
Dim i As Long
Dim j As Long
Dim k As Long
'to speed up the VBA code
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
AcceptedLastRow = ActiveWorkbook.Worksheets("Accepted").Range("A" & Rows.Count).End(xlUp).Row
Sheet1LastRow = ActiveWorkbook.Worksheets("Sheet1").Range("D" & Rows.Count).End(xlUp).Row
For j = 1 To AcceptedLastRow
For i = 1 To Sheet1LastRow
If ActiveWorkbook.Worksheets("Sheet1").Cells(i, 4).Value = ActiveWorkbook.Worksheets("Accepted").Cells(j, 1).Value Then
ActiveWorkbook.Worksheets("Accepted").Cells(j, 4).Value = ActiveWorkbook.Worksheets("Sheet1").Cells(i, 2).Value
End If
Next i
Next j
'to transfer recognised status to the recognised column and to remove from restricted column
'I think this is the section which contributes to the lag/delay
Restrictedlastrow = ActiveWorkbook.Worksheets("Accepted").Range("D" & Rows.Count).End(xlUp).Row
For k = 9 To Restrictedlastrow
If ActiveWorkbook.Sheets("Accepted").Cells(k, 4).Value <> "Restricted" Then
ActiveWorkbook.Sheets("Accepted").Cells(k, 4).Copy ActiveWorkbook.Sheets("Accepted").Cells(k, 5)
ActiveWorkbook.Sheets("Accepted").Cells(k, 4).ClearContents
End If
Next k
'to reset settings back to normal
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

Answer 1

Instead of
ActiveWorkbook.Sheets("Accepted").Cells(k, 4).Copy ActiveWorkbook.Sheets("Accepted").Cells(k, 5)
Use
ActiveWorkbook.Sheets("Accepted").Cells(k, 5) = ActiveWorkbook.Sheets("Accepted").Cells(k, 4)
Copy is an expensive operation. Since you seem to be interested only in a value of a cell, assign it directly (like you did in the previous loops).