Hallo,
bei den ws.cells(Zeile,Spalte) hättest du erste Zahl 2 gegen eine 3 tauschen müssen.

Hier nochmal der komplette Code :)

Sub KM_ändern()
    Dim WS As Worksheet
    Set WS = ActiveSheet
     
    Dim Zeichen As String
    Dim zMax As Long
    Dim Pos As Long
    Dim Idx As Long
    Dim TXT As String
    
    Dim Daten As Variant
     
    Zeichen = "0123456789,"
     
    'letzte Zeile in der Spalte 'A' (1) suchen
    zMax = WS.Cells(2 ^ 16, 1).End(xlUp).Row
    
    'Von Zeile 3 bis zur letzten Zeile die Spalte 'A' (1) in das Array 'Daten' schreiben
    Daten = WS.Range(WS.Cells(3, 1), WS.Cells(zMax, 1))
     
    'Das Array 'Daten' vom ersten zum letzten Feld durchlaufen
    For Idx = LBound(Daten, 1) To UBound(Daten, 1)
        'Wenn keine Zahl drinsteht dann ...
        If IsNumeric(Daten(Idx, 1)) = False Then
            TXT = ""
            'Durchlaufe gesamten Zellinhalt Zeichen für Zeichen
            For Pos = 1 To Len(Daten(Idx, 1))
                'Überprüfe jedes Zeichen mit erlaubten Zahlenzeichen (mit Komma)
                If InStr(1, Zeichen, Mid(Daten(Idx, 1), Pos, 1), vbTextCompare) > 0 Then
                    'Erstelle eine Zeichenkette mit den gefundenen Zahlen 
                    TXT = TXT & Mid(Daten(Idx, 1), Pos, 1)
                End If
            Next Pos
            'Geänderte Zahl wieder in Array schreiben
            'Ich addiere nur 0,1 und Runde die Zahl auf. Bei 5,7 ergibt das dann 6 und bei ganzen Zahlen eins mehr
            Daten(Idx, 1) = Application.WorksheetFunction.RoundUp(CSng(TXT) + 0.1, 0)
        End If
    Next Idx
    'Debug in Spalte 'B' (Hier die 2)
'    WS.Range(WS.Cells(3, 2), WS.Cells(zMax, 2)) = Daten
    
    'Originale Daten überschreiben ab Zeile 3 
    WS.Range(WS.Cells(3, 1), WS.Cells(zMax, 1)) = Daten
     
    Set WS = Nothing
End Sub