Sub
Verteilen()
Dim
TB
As
Worksheet, ZielTB
As
Worksheet, LR
As
Long
, i
As
Long
, SP
As
Integer
Dim
lngAb, Z
As
Integer
Set
TB = Sheets(
"Tabelle1"
)
Set
ZielTB = Sheets(
"Tabelle2"
)
lngAb = 2
SP = 1
Z = 1
LR = TB.Cells(TB.Rows.Count, SP).
End
(xlUp).Row
For
i = 1
To
LR
If
TB.Cells(i, SP) =
"Begin"
Then
lngAb = i + 1
ElseIf
TB.Cells(i, SP) =
"End"
Then
TB.Range(TB.Cells(lngAb, SP), TB.Cells(i - 1, SP)).Copy ZielTB.Cells(1, Z)
Z = Z + 1
End
If
Next
End
Sub