既存のVBAコードにエラー処理の追加をしたいのですが

質問

たびたび申し訳ないです。

エクセル2003ですが、シート2のデータをシート1のA列にある日付と1行目にある製品名とで検索をかけて当てはまるセルにシート2のデータを転記する(下記記載）コードがあります。当てはまるセルがないときはシート2の対応するセルが赤く反転するエラー処理がなされています。
以前こちらで教えていただいたのですが、このコードに更に下記のようにシート1の当てはまるセルが入力済みならば上書きしますかと言う

Worksheets("Sheet1").Cells(trgR, trgC) <>""Then
If MsgBox("上書きしますか", vbQuestion + vbOKCancel) = vbOK Then
Worksheets("Sheet1").Cells(trgR, trgC) = .Cells(idxR, 3)

このようなコードをさらに付け加えたいのですが、どのようにすればいいかご教授願います。1週間いろいろやってみたのですがうまくいきません。赤く反転するエラー処理もそのまま生かしておきたいのです。長い質問で申し訳ありませんがよろしくお願いいたします。

元のコードです。
Private Sub CommandButton1_Click()
Dim LastR, idxR As Long, trgR, trgC
With Worksheets("Sheet2")
LastR = .Range("A65536").End(xlUp).Row
trgR = Application.Match(.Cells(1, 1), Worksheets("Sheet1").Range("A:A"), 0)
For idxR = LastR To 3 Step -1
trgC = Application.Match(.Cells(idxR, 1), Worksheets("Sheet1").Range("1:1"), 0)
If IsNumeric(trgR) And IsNumeric(trgC) Then
Worksheets("Sheet1").Cells(trgR, trgC) = .Cells(idxR, 3)

Else
.Cells(idxR, 1).Interior.ColorIndex = 3
End If
Next idxR
End With

End Sub

回答No.2

KenKen_SP

そこまでできてるなら、こんな感じでそのまま追加するだけで良いと思います。

Private Sub CommandButton1_Click()
　　Dim LastR, idxR As Long, trgR, trgC
　　With Worksheets("Sheet2")
　　　　LastR = .Range("A65536").End(xlUp).Row
　　　　trgR = Application.Match(.Cells(1, 1), Worksheets("Sheet1").Range("A:A"), 0)

　　　　For idxR = LastR To 3 Step -1
　　　　　　trgC = Application.Match(.Cells(idxR, 1), Worksheets("Sheet1").Range("1:1"), 0)

　　　　　　If IsNumeric(trgR) And IsNumeric(trgC) Then
　　　　　　　　If Worksheets("Sheet1").Cells(trgR, trgC) <> "" Then
　　　　　　　　　　If MsgBox("上書きしますか", vbQuestion + vbOKCancel) = vbOK Then
　　　　　　　　　　　　Worksheets("Sheet1").Cells(trgR, trgC) = .Cells(idxR, 3)
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　Else
　　　　　　　　.Cells(idxR, 1).Interior.ColorIndex = 3
　　　　　　End If
　　　　Next idxR

　　End With

End Sub