vba - ワークシートの変更イベント VBA コードで Excel 2013 がクラッシュする

Question

最初の問題を解決する方法を人々が理解するのを手伝ってくれた後、私は新しい質問を開きました.今、私は新しい問題を抱えています. コーディングは、以下の「INITIATING DEVICES」ページにあります。コードの最後から 2 番目の部分のアイデアは、B7:b と E7:E から列 (テキスト値) を追加し、それを列 J7:J に表示することでした。したがって、Photo が B に入力され、Pass が列 E に入力された場合、結果は列 J に Photopass になります。元のコードは、マクロ コマンドを介して実行すると正常に動作します。問題は、既存のコードの一部に追加しようとしたところ、情報が任意のセルに入力されるとプログラム全体がクラッシュすることです。プログラムが応答しなくなり、シャットダウンして再起動します。コードまたはデバッグ メッセージが表示されません。このページのコード全体を次に示します。

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 7 And UCase(Target.Value) = "YES" Then
    Sheets("MESSAGE CHANGES").Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 3) = Sheets("INITIATING DEVICES").Cells(Target.Row, 1).Resize(, 3).Value
    Application.Goto Sheets("MESSAGE CHANGES").Cells(Rows.Count, 1).End(xlUp).Offset(, 3)

End If


 If Target.Column = 6 And UCase(Target.Value) = "YES" Then
    Sheets("DEVICE NOTES").Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 3) = Sheets("INITIATING DEVICES").Cells(Target.Row, 1).Resize(, 3).Value
    Application.Goto Sheets("DEVICE NOTES").Cells(Rows.Count, 1).End(xlUp).Offset(, 3)

End If


 '(replace if new code fails)If Target.Column = 5 And UCase(Target.Value) = "FAIL" Or Target.Column = 5 And UCase(Target.Value) = "DAMAGED" Then
    '(replace if new codes fails)Sheets("FAILED DEVICES").Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 3) = Sheets("INITIATING DEVICES").Cells(Target.Row, 1).Resize(, 3).Value
 If Target.Column = 5 And UCase(Target.Value) = "FAIL" Or UCase(Target.Value) = "DAMAGED" Then
    Application.EnableEvents = False
    Sheets("FAILED DEVICES").Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 5) = Sheets("INITIATING DEVICES").Cells(Target.Row, 1).Resize(, 5).Value
    Sheets("FAILED DEVICES").Cells(Rows.Count, 1).End(xlUp).Offset(, 5) = Sheets("INITIATING DEVICES").Cells(Target.Row, 11).Value
    Application.EnableEvents = True


End If
'code that will place date/time when value is selcted in E
If Not Intersect(Target, Range("E:E")) Is Nothing Then
   Range("I" & Target.Row).Value = Now

End If

Dim wb As Workbook
Dim ws As Worksheet
Dim lastRow As Long

Set wb = ThisWorkbook
Set ws = wb.Sheets("INITIATING DEVICES")

lastRow = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
ws.Range("J7:J" & lastRow).Value = Evaluate("=B7:B" & lastRow & "&E7:E" & lastRow)


End Sub


Private Sub Workbook_BeforePrint(Cancel As Boolean)
With Sheets("INITIATING DEVICES")
    .PageSetup.PrintArea = .Range("A1:H" & .Cells(Rows.Count, 1).End(xlUp).Row).Address
End With

End Sub

ご協力いただきありがとうございます。さらに情報が必要な場合は、検査ファイルを送信し、必要に応じてより多くの情報を提供することもできます。私は何かを台無しにしたと確信しています。それがクラッシュし続ける理由です。ここはまだまだ勉強中。