Hi

Try

Code:
Sub kTest()
    
    Dim ka, k(), i As Long, n As Long, c As Long
    
    ka = Range("a1").CurrentRegion.Resize(, 2)
    
    ReDim k(1 To UBound(ka, 1), 1 To 7)
    
    For i = 2 To UBound(ka, 1)
        If i = 2 Then
            n = n + 1: c = c + 1
            k(n, 1) = ka(i, 1): k(n, 2) = ka(i, 1): k(n, 3) = c
            k(n, 5) = ka(i, 2): k(n, 6) = ka(i, 2): k(n, 7) = c
        Else
            If ka(i, 2) - ka(i - 1, 2) = 1 Then
                c = c + 1: k(n, 2) = ka(i, 1): k(n, 3) = c
                k(n, 6) = ka(i, 2): k(n, 7) = c
            Else
                n = n + 1: c = 1
                k(n, 1) = ka(i, 1): k(n, 2) = ka(i, 1): k(n, 3) = c
                k(n, 5) = ka(i, 2): k(n, 6) = ka(i, 2): k(n, 7) = c
            End If
        End If
    Next
    If n Then
        Range("d1:j1") = Array("Start", "End", "Qty Count", "", "MCP Start", "MCP End", "MCP Count")
        Range("d2").Resize(n, 7) = k
    End If
    
End Sub