通常実行では中断されるが一行ずつ実行すると上手くいく

投稿者 : だるま     投稿日時 : 2025/03/03(Mon) 12:36:15     OS : Windows 11     EXCEL : Office 365

---

お世話になります。
色々なサイトを参考にして自分の希望に合わせて組み合わせてみたのですが、実行すると所々で中断され続けます。
しかし、中断されるたび継続をすると上手くいきます。
この場合どのように修正すれば中断されなくなるのかご教示いただけますと幸いです。
中断個所を下記に記載させていただきました。
何卒よろしくお願いいたします。



"SC"という名のシートをコピーし、一番右に追加
名前を変更(中断)
End If(中断)
入力されているセル全体をコピー値のみペースト
1行目を削除(中断)
AE~BI列を削除(中断)
For i = 168 To 138 Step -1(中断)
136行目から169行目でA列に「Delete」と書かれている行を削除(1行ごとに中断)
For i = 89 To 45 Step -1(中断)
45行目から90行目でB列に「Delete」と書かれている行を削除(1行ごとに中断)

Sub SCコピー()

Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("SC")

Dim wsName As String
wsName = ws.Cells(1, 11).Value

Dim i As Long

' 同名のワークシートがないことをチェック
If nameCheckFlag(wsName) = True Then
    
    MsgBox "同名のシートが存在するため、シートを作成できません。"

Else
    ' 「SC」シートをコピーして一番右に追加。
    ws.Copy After:=Sheets(Sheets.Count)

    ' 追加したシートがActiveになっているので、ActiveSheetを通じて名前を設定。
    ActiveSheet.Name = wsName
    
End If
    
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Application.DisplayAlerts = False
Range("A1").PasteSpecial xlPasteValues
Rows(1).Delete
Columns("AE:BI").Delete

    ' 138～168行目を順番に判定し、A列(1列目)のセルに「Delete」を含んでいた時にその行を削除。
For i = 168 To 138 Step -1
    If InStr(Cells(i, 1).Value, "Delete") >= 1 Then
    Rows(i).Delete
    End If
Next i

    ' 45～89行目を順番に判定し、B列(2列目)のセルに「Delete」を含んでいた時にその行を削除。
For i = 89 To 45 Step -1
    If InStr(Cells(i, 2).Value, "Delete") >= 1 Then
    Rows(i).Delete
    End If
Next i

End Sub

' 同名のワークシートがないかチェックする関数
Function nameCheckFlag(wsName As String) As Boolean
    Dim ws As Worksheet
    
    For Each ws In Worksheets
        If wsName = ws.Name Then
            nameCheckFlag = True
            Exit For
        Else
            nameCheckFlag = False
        End If
    Next ws

End Function

投稿者 : thatsme     投稿日時 : 2025/03/03(Mon) 13:30:55

---

どこか時間ががかかりそうだと思うところの次に
Doevents
でも入れてやるとか

投稿者 : だるま     投稿日時 : 2025/03/03(Mon) 15:29:03

---

OSを再起動したところ解決しました。