Do you want to copy and then paste it somewhere? If so, where?
Sub CopyCell()
Application.ScreenUpdating = False
Dim bottomD As Long
bottomD = Range("D" & Rows.Count).End(xlUp).Row
Dim rng As Range
For Each rng In Range("D2:D" & bottomD)
If rng = "" Then
rng = Range("P" & rng.Row)
Range("P" & rng.Row).ClearContents
End If
Next rng
Application.ScreenUpdating = True
End Sub
Sub CopyCell()
Application.ScreenUpdating = False
Dim bottomD As Long
bottomD = Range("D" & Rows.Count).End(xlUp).Row
Dim rng As Range
For Each rng In Range("D2:D" & bottomD)
If rng = "" Then
Range("P" & rng.Row).Copy
Range("D" & rng.Row).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Range("P" & rng.Row).ClearContents
End If
Next rng
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
okay I hit a bug, It is not copying or deleting the last 2 rows?