Sub Move_Cell_Down_v1()
Dim rFound As Range
'Clear any existing formatting settings for the Find process
Application.FindFormat.Clear
'Set the formatting that we want to look for (the blue cell)
Application.FindFormat.Interior.Color = RGB(0, 176, 240)
'Look in col AL for the blue cell and set rFound to be that cell
Set rFound = Columns("AL").Find(What:="", LookIn:=xlFormulas, SearchFormat:=True)
'This is just to stop the code erroring if there happens to be no blue cell
If Not rFound Is Nothing Then
'Starting 2 cells right of blue cell (rFound) and for 2 cells from that one, transfer the values from rows 25:26
rFound.Offset(, 2).Resize(2).Value = Range("AN25:AN26").Value
'Cut the Blue cell and paste it 2 cells down (or to row 40 if we are at the end)
rFound.Cut Destination:=Cells(IIf(rFound.Row = 66, 40, rFound.Row + 2), rFound.Column)
End If
'Clear the blue formatting seeting from Find so that it doesn't impede any other Find operations that you might do
Application.FindFormat.Clear
End Sub