Hier die Lösung, die eine Option dafür darstellt.

Sub Ausfuellen()

' ====================================================================================
' Makro:       Ausfuellen
'
' ====================================================================================
' History:
'
' Inhalt:
' Es soll die Zeile bestimmt werden, die den Suchtext = "#Ende# nichts hinter dieser Zeile eintragen" enthält,
' der Zeilenwert soll gespeichert bleiben für ein spätere Schleife
' Es soll zur Spalte X (Prüfungsnummer) gegangen werden.  (Achtung es könnte sein, das diese Info nächste Woche
' an eine andere Stelle wandert.)
' Dann soll ab Zeile 3 von X geprüft werden, ob der Wert numerisch ist  und bis zum Ende nur einmal vorkommt.
' Im Prinzip soll ein Makro erzeugt werden, was auf Klick in Spalte X alle Zellen durchnummeriert , wo bei das
' Makro auch später eingefügte Spalten mit Zahlenwerten versehen soll
' Bei vorliegendem Beispiel soll das Makro erkennen, das in Zeile 13 der höchste Wert 6 steht und dies der Basiswert ist, um in Zeile 7 den Wert 7, in zeile 8 den ' Wert 8 und in Zeile 9 den Wert 9 , in Zeile 11 dann den Wert 10, in Zeile 12 den Wert 11  und in Zeile 14 dann den Wert 12 bis zum Ende eintragen.
' Es soll eine Fehlermeldung geben, wenn ein Wert mehrfach vorkommt.
' ====================================================================================

'

    Dim wbZiel As Workbook
    Set wbZiel = ThisWorkbook
    Dim RngBereich As Range
    Dim rZeile As Range
    Dim rSpalte As Range
    Dim endList As Integer
    Dim anfangZeile As Integer
    Dim findSpalte As Integer
    Dim Fehler As Integer
    Dim Gefunden As Boolean
    
    Dim Suchtext As String: Suchtext = "#Ende# nichts hinter dieser Zeile eintragen"
    Dim maxWert As Integer
    
    'Es soll die Zeile bestimmt werden, die den Suchtext =
    ' "#Ende# nichts hinter dieser Zeile eintragen" enthält,
    ' der Zeilenwert soll gespeichert bleiben für ein spätere Schleife
    
    wbZiel.Sheets("MTU-Tool").Select
    Columns("A:A").Select
    With Selection.Rows
        Set rZeile = .Find(what:=Suchtext, lookat:=xlWhole)
        If Not rZeile Is Nothing Then
            endList = rZeile.Row
        Else
            Fehler = 1 'Doppelter Wert gefunden
            endList = 0 'Fehler, da nicht gefunden -> raus aus Makro
            GoTo Ende
        End If
        
    End With
    
    ' Es soll zur Spalte X (Prüfungsnummer) gegangen werden.
    ' (Achtung es könnte sein, das diese Info nächste Woche an
    ' eine andere Stelle wandert.)
    Suchtext = "Prüfungs #"
    Rows("2:2").Select
    With Selection.Columns
        Set rSpalte = .Find(what:=Suchtext, lookat:=xlWhole)
        If Not rSpalte Is Nothing Then
            findSpalte = rSpalte.Column
        Else
            Fehler = 2 'Fehler da nichts gefunden, -> raus
            findSpalte = 0
            GoTo Ende
        End If
    End With
  ' Dann soll ab Zeile 3 von X geprüft werden, ob der Wert numerisch ist
  ' und bis zum Ende nur einmal vorkommt.
    anfangZeile = 3
    Gefunden = False
    Dim x As Long
    For x = anfangZeile To endList
        Cells(x, findSpalte).Interior.ColorIndex = 2 'Farbe zurücksetzen, falls sie schon einmal markiert wurde
        If WorksheetFunction.CountIf(Range(Cells(anfangZeile, findSpalte), Cells(endList, findSpalte)), Cells(x, findSpalte)) > 1 Then
            
            Cells(x, findSpalte).Interior.ColorIndex = 3
            Gefunden = True
        End If
    Next x
    Dim response As Byte
    If Gefunden Then
        response = MsgBox("Es wurden doppelte Einträge gefunden und rot markiert! """ & _
        vbLf & """ Abruch?", 4, "Achtung:")
        If response = vbYes Then Exit Sub
    End If
    ' Im Prinzip soll ein Makro erzeugt werden, was auf Klick in Spalte X alle Zellen durchnummeriert , wo bei das Makro auch
    ' später eingefügte Spalten mit Zahlenwerten versehen soll
    Set RngBereich = ActiveSheet.Range(Cells(anfangZeile, findSpalte), Cells(endList, findSpalte))
    maxWert = maxWert + 1
    Dim Zelle As Variant
    For Each Zelle In Selection
            If Zelle = "" And Cells(Zelle.Row, 1) <> "" Then
            Cells(Zelle.Row, Zelle.Column) = maxWert
    maxWert = Application.Max(RngBereich)
    Range(Cells(anfangZeile, findSpalte), Cells(endList - 1, findSpalte)).Select
            maxWert = maxWert + 1
        End If
    Next Zelle
    MsgBox "Ready!"
    Exit Sub
    
  ' Es soll eine Fehlermeldung geben, wenn ein Wert mehrfach vorkommt.
Ende:
Select Case Fehler
    Case 1
        MsgBox "Der Begriff  """ & Suchtext & """  wurde nicht gefunden.", _
            48, "   Hinweis für " & Application.UserName
    Case 2
        MsgBox "Der Begriff  """ & Suchtext & """  wurde nicht gefunden.", _
            48, "   Hinweis für " & Application.UserName
    Case 3
        MsgBox "Doppelter Wert """ & x & """ gefunden .", _
            48, "   Hinweis für " & Application.UserName
End Select
Exit Sub

End Sub