Sub ElementeAnordnen()
Dim arrColOrder As Variant, ndx As Integer
Dim Found As Range, counter As Integer
arrColOrder = Array("Al", "Cr", "Cu", "Mn", "Mo", "Ti")
counter = 1
Application.ScreenUpdating = False
For ndx = LBound(arrColOrder) To UBound(arrColOrder)
Set Found = Rows("20:20").Find(arrColOrder(ndx), LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
If Not Found Is Nothing Then
If Found.Column <> counter Then
Found.EntireColumn.Cut
Columns(counter).Insert Shift:=xlToRight
Application.CutCopyMode = False
End If
counter = counter + 1
End If
Next ndx
Application.ScreenUpdating = True
End Sub