別シートにコピペするExcelVBA

質問

超初心者なのですが、業務処理の簡素化のため、色々調べながら、下記を作りました。
が、、、うまく動いてくれません。。

やりたいことは、D列に「OK」とある行を、「終了リスト」というSheetにコピーし、コピーした行を削除。
その処理の前に、メッセージボックスで処理を進めて問題ないか確認する。。。です。

メッセージボックスでの処理分岐を入れようとして、色々記述を変えたところ、エラーになってしまいました。。。
どなたか、お詳しい方がいらっしゃいましたら、誤っている箇所をご指摘、ご教授いただけないでしょうか。
それから、もし可能であれば件数が０件の場合は、「対象なし」と表示したいです。

どうぞ宜しくお願いいたします。

Sub 終了処理()

Dim cnt As Long
Dim chk As Integer
Dim i, LastRow As Long
Dim myMsg1 As String, myMsg2 As String

myMsg1 = "終了件数は"
myMsg2 = "件です。完了しますか？"

cnt = WorksheetFunction.CountIf(ActiveSheet.Range("A3:A65536"), "OK")
chk = MsgBox(myMsg1, cnt, myMsg2, vbYesNo)

If chk = vbYes Then
LastRow = Cells(Rows.Count, 4).End(xlUp).Row
For i = 1 To LastRow
If Cells(i, 4) = "OK" Then
Rows(i).Copy Sheets("終了リスト").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Rows(i).Delete shift:=xlUp
Next i

End If
End Sub

どうぞ宜しくお願いいたします。

回答No.3

ap_2

おう・・書いてる間に投稿が。あっちは説明丁寧だ（ｐ＿ｑ

ANo.1＋文字列は＆で結合してからMsgBoxに、ね。
　×MsgBox(myMsg1, cnt, myMsg2,
　○MsgBox(myMsg1 & cnt & myMsg2,

細かい部分は適当に解釈して書いたから、チェックしてね。

回答No.2

ap_2

調べながらでコレなら、大したもんだと思うんだ。
ということで、説明省略。動作未確認。あと任せた。
不明な点あれば補足で。
※cnt = ... 以降を修正

LastRow = Cells(Rows.Count, 4).End(xlUp).Row
cnt = WorksheetFunction.CountIf(Range("D3:D" & LastRow), "OK")
If cnt = 0 Then
　'OKが無い
　MsgBox "おなかすいた", vbYesOnly
Else
　'OKがある
　chk = MsgBox(myMsg1 & cnt & myMsg2, vbYesNo)
　If chk = vbYes Then
　　'Deleteで行数が変わるので下から処理。D3まで？
　　For i = LastRow To 3 Step -1
　　　If Cells(i, 4) = "OK" Then
　　　　'コピー＆削除
　　　　Rows(i).Copy Sheets("終了リスト").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
　　　　Rows(i).Delete shift:=xlUp
　　　End If
　　Next i
　End If
End If
End Sub

コメント入れるといいよ。あと、段わけすると間違えてEnd If消すこともない。

補足

ap_2様

早々にご回答をいただいているのに、お礼とレスが遅くなっており、大変申し訳ありません。

VBAまで丁寧に時間を割いて記載いただきましてありがとうございます！間に入れていただいているコメントも初心者でもわかりやすくて、とても助かります。

実は、ただいまPCがトラぶっておりまして、、ご教授いただいたVBAを、まだ実験できておりません。。。　

PCが回復次第、ご教授いただいた方法でチャレンジしたいと思っております。

もう少々、お時間ください。

回答No.1

mt2008

ざっと見て気が付いたところを……

まず、「OK」という文字を、D列からではなく、A列で探しています。
cnt = WorksheetFunction.CountIf(ActiveSheet.Range("A3:A65536"), "OK")
↓
cnt = WorksheetFunction.CountIf(ActiveSheet.Range("D:D"), "OK")

次に　If Cells(i, 4) = "OK" Then　に対するEnd Ifがありません。
Next i　の1つ上に入れましょう。

あと、上から1行づつ探して削除していますが、これでは駄目です。
例えば、3行目と4行目に「OK」が入っていたとします。
3行目の「OK」を見つけてコピーと削除を行うと、4行目が3行目になりますが、今のコードでは次に4行目（元5行目）をチェックしますので元4行目の「OK」は残ってしまいます。
これを避けるには下から上に見ていきます。また、それに合わせてコピーも変えてやります。
For i = 1 To LastRow
　　If Cells(i, 4) = "OK" Then
　　　　Rows(i).Copy Sheets("終了リスト").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
　↓
For i = LastRow To 1 Step -1
　　If Cells(i, 4) = "OK" Then
　　　　Rows(i).Copy
　　　　Sheets("終了リスト").Rows(2).Insert shift:=xlDown　'コピーした行を終了リストの2行目に挿入

補足

mt2008様

早々にご回答をいただいているのに、お礼とレスが遅くなっており、大変申し訳ありません。

実は、ただいまPCがトラぶっておりまして、、ご教授いただいたのに、まだファイルにされていない状況です。

下から削除の件、詳しくご説明いただきましてありがとうございます。なるほど。。VBAを書く（？）時には、削除されて参照先が変わる。。まで想定してかかなければおかしくなるんですね。

自分で行コピー削除のVBA作ったときに実験はしたのですが、行飛んでOKにしていたので、連続行でうまくいかなくなる。ということには全く気づいていませんでした。

PC回復したら、上記もあわせて再度実験して勉強したいともいます。