Option
Explicit
Sub
umformen()
Dim
letzteZeile
Dim
i
As
Long
Dim
spalte
As
Long
Dim
neuZeile
As
Long
Dim
neuSpalte
As
Long
letzteZeile = 0
For
spalte = 1
To
5
letzteZeile = ActiveSheet.Cells(Rows.Count, spalte).
End
(xlUp).Row
Next
spalte
ActiveSheet.Range(ActiveSheet.Cells(1, 8), ActiveSheet.Cells(1000, 20)).ClearContents
neuZeile = 0
neuSpalte = 0
For
i = 1
To
letzteZeile
If
ActiveSheet.Cells(i, 1) <>
""
And
ActiveSheet.Cells(i, 4) =
""
Then
neuZeile = neuZeile + 1
ActiveSheet.Cells(neuZeile, 8) = ActiveSheet.Cells(i, 1)
ElseIf
ActiveSheet.Cells(i, 1) <>
""
And
ActiveSheet.Cells(i, 2) <>
""
Then
neuZeile = neuZeile + 1
ActiveSheet.Cells(neuZeile, 8) = ActiveSheet.Cells(i, 1)
ActiveSheet.Cells(neuZeile, 9) = ActiveSheet.Cells(i, 2)
ActiveSheet.Cells(neuZeile, 11) = ActiveSheet.Cells(i, 4) &
" - "
& ActiveSheet.Cells(i, 5)
ElseIf
ActiveSheet.Cells(i, 1) =
""
And
ActiveSheet.Cells(i, 4) <>
""
And
ActiveSheet.Cells(i, 5) <>
""
Then
neuSpalte = ActiveSheet.Cells(neuZeile, Columns.Count).
End
(xlToLeft).Column
ActiveSheet.Cells(neuZeile, neuSpalte + 1) = ActiveSheet.Cells(i, 4) &
" - "
& ActiveSheet.Cells(i, 5)
Else
End
If
Next
i
End
Sub