Sub Umstellen()
Dim arr As Variant
Dim i As Long
Dim var As String
Dim varU As Long
Dim sp As Long
arr = Range("A1").CurrentRegion
varU = Cells(Rows.Count, 6).End(xlUp).Row + 1
For i = LBound(arr) To UBound(arr)
Select Case UCase(arr(i, 1))
Case "KONTONUMMER"
sp = 5
var = arr(i, 2)
Case "NAME"
sp = 6
Case "BESTAND"
sp = 7
End Select
If sp = 5 Then
Cells(varU, sp).Value = arr(i, 2)
Else
Cells(varU, 5).Value = var
Cells(varU, sp).Value = arr(i, 2)
End If
If sp = 7 Then varU = varU + 1
Next i
End Sub