Sub Materialliste()
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Columns("D:R").Select
Selection.Delete Shift:=xlToLeft
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Columns("C:C").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("B:B").Select
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("C:C").Select
ActiveWindow.SmallScroll Down:=-18
Selection.ClearContents
Range("C18").Select
ActiveWindow.SmallScroll Down:=-42
Range("C1").Select
ActiveCell.FormulaR1C1 = "=AUFRUNDEN(B1;1)"
Range("C1").Select
ActiveCell.FormulaR1C1 = "=AUFRUNDEN(B1;0)"
Range("C1").Select
ActiveCell.FormulaR1C1 = "=AUFRUNDEN(B1;0)"
Columns("C:C").ColumnWidth = 14.86
Selection.NumberFormat = "General"
Range("C1").Select
ActiveCell.FormulaR1C1 = "=ROUNDUP(RC[-1],0)"
Range("C1").Select
Selection.AutoFill Destination:=Range("C1:C503"), Type:=xlFillDefault
Range("C1:C503").Select
ActiveWindow.SmallScroll Down:=-513
Dim UG As String
Dim OG As String
UG = "0.1"
OG = "99999999999.9"
With Tabelle1.UsedRange
With .Columns(.Columns.Count).Offset(, 1)
.Formula = "=IF(OR(MIN(RC1:RC[-1])<" & UG & ",MAX(RC1:RC[-1])>" & OG & "),1,"""")"
.Value = .Value
.EntireRow.Sort .Cells(1), xlAscending, Header:=xlNo
On Error Resume Next
.SpecialCells(xlCellTypeConstants, xlNumbers).EntireRow.Delete
.ClearContents
On Error GoTo 0
End With
End With
Selection.Copy
Columns("B:B").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("C:C").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("E12").Select
ActiveWindow.SmallScroll Down:=60
Dim sName As String
sName = Split(ThisWorkbook.FullName, ".")(0)
Call ThisWorkbook.SaveAs( _
Filename:=sName, _
FileFormat:=xlCSVMSDOS, _
CreateBackup:=False)
End Sub