For R1 =  1  To Var1
' У тебя инициализация происходит один раз при очистке доски
' После этого весь расчет крутится в цикле Do ... Loop,
' а там только увеличение счетчика окончания цикла
' Поэтому когда проходит 9 ходов заканчивается игра :)))
    R = CInt(Rnd * Var1)
    k = R ' Вариант хода
    Do 'Цикл до строки Loop - это цикл по количеству вариантов ходов.
        var_x = x + D_x(k) ' Горизонтальная координата потенциального хода.
        var_y = y + D_y(k) ' Вертикальная координата потенциального хода.
        '/////// проверка местоположения клетки потенциального хода
        If var_x <  1  Or var_x >  8  Or var_y <  1  Or var_y >  8  Then ' проверка. есть ли выход за пределы доски, если да то 
переход к следующему варианту
            k = k + k 'Если клетка вне доски, то переход к следующему варианту.
        ElseIf Cells(var_y, var_x) <> "" Then ' если поле занято, то поиск нового хода.
            k = k +  1  ' ( А тут он выбрасывает у меня ошибку!) Ставлю  k = k + 1, то ничего не виснет, но посик ходов 
прекращается, хотя варианты еще есть.
        Else
            x = var_x
            y = var_y
            Nomer = Nomer +  1 
            Cells(y, x).Value = Nomer

            MsgBox "Координаты > " & D_x(k) & "|" & D_y(k) & " Вариант " & k

            k = k + k ' Для следующего хода начинаем просмотр вариантов с первого.
            flag =  0 
            While flag =  0 
                DoEvents
            Wend
        End If
    Loop While k <  9  ' Завершение цикла Do (Ходов больше Нет)
Next R1

Option Explicit

Private Type Point
    x As Long
    y As Long
End Type

Dim D_x() As Variant
Dim D_y() As Variant
Dim ptWorkPoint As Point
'Dim flag As Integer
Dim Nomer As Long

Private Sub Bgn_Click() ' Кнопка начать игру
Randomize
D_x = Array( 0 ,  1 ,  2 ,  2 ,  1 , - 1 , - 2 , - 2 , - 1 )
D_y = Array( 0 , - 2 , - 1 ,  1 ,  2 ,  2 ,  1 , - 1 , - 2 )

Nomer =  1  ' Эта переменная представляет счетчик ходов.

' Считывание начального положения шахматной фигуры
With ptWorkPoint
    .x = CLng(Val(T_x.Text))
    .y = CLng(Val(T_y.Text))
End With
Randomize CDbl(Time) *  1000 

Cells(ptWorkPoint.y, ptWorkPoint.x).Value = Nomer 'В ячейку листа записывается номер хода

Bgn.Enabled = False
Nxt.Enabled = True
' Если нужен сразу первый ход, раскомментировать
'Call Nxt_Click
End Sub

Private Function CalcNextStep(ByRef pt As Point) As Point
' Функция просчитывает координаты следующего хода
Dim ptTmp As Point, i As Long, bFlag As Boolean
bFlag = False
' Получаем новую координату случайным образом
ptTmp = GetNewCoord()
With ptTmp
    .x = .x + pt.x
    .y = .y + pt.y
End With
If Not CheckNewCoord(ptTmp) Then
' проверка. есть ли выход за пределы доски или поле занято то поиск нового хода.
' Но уже не случайным образом, а систематически
    For i = LBound(D_x) To UBound(D_x)
    ' Получаем новую координату
        ptTmp = GetNewCoord(i)
        With ptTmp
            .x = .x + pt.x
            .y = .y + pt.y
        End With
        ' проверяем на валидность
        If CheckNewCoord(ptTmp) Then
            ' Если нашли, завершаем цикл и функцию вообще
            CalcNextStep = ptTmp
            bFlag = True
            Exit For
        End If
    Next i
    If Not bFlag Then
    ' если не нашли координат, а прошли весь массив коэфициентов
    ' значит попали в тупик и ходить дальше некуда, о чем и скажем :)
        With CalcNextStep
            .x = - 100 
            .y = - 100 
        End With
    End If
Else
    CalcNextStep = ptTmp
End If
End Function

Private Sub ShowStep(ByRef pt As Point, nNomerStep As Long)
' Процедура выводит следующий ход
Cells(pt.y, pt.x).Value = nNomerStep
End Sub

Private Function CheckNewCoord(ByRef ptCheck As Point) As Boolean
' Проверяем "свободность" точки предполагаемого хода
On Error Resume Next
' Ошибка может происходить на проверке "занятости" клетки, при индексах меньше 1
If ptCheck.x <  1  Or ptCheck.x >  8  Or ptCheck.y <  1  Or ptCheck.y >  8  Then
    CheckNewCoord = False
ElseIf Cells(ptCheck.y, ptCheck.x).Value <> " " Then
    CheckNewCoord = False
Else
    CheckNewCoord = True
End If
End Function

Private Function GetNewCoord(Optional ByVal lRandom As Long =  0 ) As Point
' Функция возвращает новую комбинацию коэфициетнов для хода
Dim R As Long
If lRandom =  0  Then
    R = CLng(Rnd(CDbl(Time) *  1000 ) * UBound(D_x))
Else
    R = lRandom
End If
If R > UBound(D_x) And R < LBound(D_x) Then
    R =  0 
End If
With GetNewCoord
    .x = D_x(R)
    .y = D_y(R)
End With
End Function

Private Sub Clr_Click() ' Кнопка Очистеть поле
Range("A1:H8").Value = " "
Bgn.Enabled = True
Nxt.Enabled = False
End Sub

Private Sub Nxt_Click() ' Кнопка след. хода
Dim pt As Point
pt = CalcNextStep(ptWorkPoint)
If pt.x <> - 100  Then
    Nomer = Nomer +  1 
    Call ShowStep(pt, Nomer)
    ptWorkPoint = pt
Else
    MsgBox "Дальше ходить некуда"
End If
End Sub