Option Explicit
Sub IncrementCheck()
    Dim c1 As Integer
'    Range("B1").Select
    ActiveCell.Select
    c1 = ActiveCell.Value
    MsgBox "Start " & c1
    ActiveCell.Offset(1, 0).Select
    Do Until ActiveCell.Value = ""
        If ActiveCell.Value <> c1 + 1 Then
            MsgBox "値不正" & c1 & "→" & ActiveCell.Value
            Exit Sub
        End If
        c1 = c1 + 1
        ActiveCell.Offset(1, 0).Select
    Loop
    MsgBox "正常終了 " & c1
End Sub