VBA 毎回データが違っても応用できるコード2

質問

先ほどの回答をありがとうございました。
https://okwave.jp/qa/q9539233.html

手順が違っていましたので、再度質問させて頂きたいと思います。宜しくお願いします。

O列をフィルタで昇順にします。
2以上の数値（#N/Aも含む）が入った行のP列をコピーして同じ行のQ列に値でペーストするといった流れです。
見やすくするため、ペーストしたものは赤い文字にしてくれたらありがたいです。

O列　　　　P列　　　　Q列
2　　　　　79　　　　　79
2　　　　　79　　　　　79
3　　　　　#N/A　　　　#N/A
4　　　　　#N/A　　　　#N/A
5　　　　　80　　　　　80
8　　　　　80　　　　　80
8　　　　　80　　　　　80
10　　　　　80　　　　80
11　　　　　80　　　　80
18　　　　　#N/A　　　#N/A
#N/A　　　　84　　　　84
#N/A　　　　80　　　　80
　　　　　　↑　　　　↑
　　　　　コピー　　値でペースト

回答No.1

watabe007 · ベストアンサー

Sub Test()
　　Dim LR As Long, i As Long
　　'O列の最終行を検出
　　LR = Cells(Rows.Count, "O").End(xlUp).Row
　　'O列からQ列の範囲をO列をキーに昇順で並び替え
　　ActiveSheet.Range("O1:Q" & LR).Sort _
　　Key1:=Range("O1"), Order1:=xlAscending, Header:=xlYes
　　'2以上の行を検出
　　For i = 2 To LR
　　　　If Cells(i, "O").Value >= 2 Then Exit For
　　Next
　　Range(Cells(i, "P"), Cells(LR, "P")).Copy
　　Cells(i, "Q").PasteSpecial Paste:=xlPasteValues
　　Range(Cells(i, "Q"), Cells(LR, "Q")).Font.Color = vbRed
　　Application.CutCopyMode = False
End Sub

お礼

毎回教えて頂き、ありがとうございます！
おかげ様でうまくいけました。
またお世話になるかと思います。
その時は宜しくお願いします。