Код выполняется несколько раз

Sub ðàçáèòü()
  Dim x&, i&, j&, nom, a
      nom = 2
    x = Cells(Rows.Count, 2).End(xlUp).Row - 9
    
    
      For i = x To 2 Step -1
        If Cells(i, 6) = Empty Then
          Rows(i).Delete
        End If
        If Cells(i, 6) >= 10000 Then
        Cells(i, 5) = 1
        End If
        If Cells(i, 6) >= 20000 Then
        Cells(i, 5) = 2
        End If
        If Cells(i, 6) >= 30000 Then
        Cells(i, 5) = 3
        End If
        If Cells(i, 6) >= 40000 Then
        Cells(i, 5) = 4
        End If
        If Cells(i, 6) >= 50000 Then
        Cells(i, 5) = 5
        End If
        If Cells(i, 6) >= 60000 Then
        Cells(i, 5) = 6
        End If
        If Cells(i, 6) >= 70000 Then
        Cells(i, 5) = 7
        End If
     Next
     
     
     For j = x To 2 Step -1
        If Cells(j, 5) = 3 Then
            Rows(j).Select
            Selection.Copy
            Sheets("3-òåõ").Activate
            Rows(nom).Select
            ActiveSheet.Paste
            Sheets("1-òåõ").Activate
            Rows(j).Delete
            nom = nom + 1
        End If
     Next
End Sub