Hallo,

vielen Dank schon mal für die Unterstüzung

Die verschiedenen Numberformate (General oder Number) hab ich im aktuellen Makro schon drinbzw. getestet. (das oben war auch nur der Auszug wo das Problem besteht.)

Hab das auch mit der For-Schleife versucht, aber auch hier das selbe, die Zahlen bleiben als "Text" in der Zelle.

Hier das ganze Makro, in der Mitte (nach Selection.Autofilter) die Sachen die ich nun alle schon versucht habe aber immer das selbe Problem.

Excel selbst brint ja auch den den hinweis bei den Zellen "Die Zahl in dieser Zelle ist als Text formatiert....", obwohl im Format-Dropdown "Standard" steht.

Dim startPunkteReihe As Integer
Dim endePunkteReihe As Integer
Dim startPunkteSpalte As Integer
Dim endePunkteSpalte As Integer
Dim c As Range
Dim r As Range

startPunkteSpalte = 1

    cells(1, 1).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Offset(1, 0).Select
    
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    
    startPunkteReihe = Selection.Row
    endePunkteReihe = startPunkteReihe + Selection.Rows.Count - 1
    startPunkteSpalte = Selection.Column
    endePunkteSpalte = startPunkteSpalte + Selection.Columns.Count - 1
    
    Selection.AutoFilter
    
    Set c = Range(cells(startPunkteReihe, startPunkteSpalte), cells(startPunkteReihe, endePunkteSpalte))
    Set c = c.Find("Laenge")
    If Not c Is Nothing Then
        Set r = Range(c, c.Offset(endePunkteReihe - startPunkteReihe, 1))


        
        r.NumberFormat = "General"
        
        Dim abc As Range
        For Each abc In r.Offset(1, 0)
            abc.Value = Left(abc.Value, Len(abc.Value) - 3)
        Next
'        r.Replace What:=" mm", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False



        c.Offset(-1, 0).Value = 1
        c.Offset(-1, 0).Copy
        c.Offset(2, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlMultiply, _
        SkipBlanks:=False, Transpose:=False



        
        c.Offset(-1, 0).Formula = "=SUBTOTAL(9," & r.Columns(1).Address & ")"
    Else
        MsgBox ("Spalte ""Länge"" nicht gefunden")
    End If
        Columns("A:A").ColumnWidth = 33.29
        Columns("B:B").ColumnWidth = 33.86