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
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