Sub addrow5()
    Application.ScreenUpdating = False
    rw = ActiveCell.Row
    For i = 1 To 5
        Rows(rw + i).Insert
    Next
    lr = Cells(Rows.Count, "B").End(xlUp).Row
    If rw + 5 > lr Then lr = rw + 5
    arr = Range("B5:B" & lr).Value
    For i = 2 To UBound(arr)
        If IsNumeric(arr(i, 1)) Then
            If IsNumeric(arr(i - 1, 1)) Then
                arr(i, 1) = arr(i - 1, 1) + 1
            Else
                arr(i, 1) = 1
            End If
        End If
    Next
    Range("B5:B" & lr) = arr
    Range("B5:G" & lr).Borders.LineStyle = True
    Application.ScreenUpdating = True
End Sub