Option Explicit
Sub Etiketten()
Dim TB As Worksheet, LR As Integer, i As Integer, j As Integer
Dim Sp As Integer, Ze As Integer, S1 As Integer, Z1 As Integer
Dim SpPos As Integer, SpZng As Integer, SpSt As Integer
Dim Zeile As Integer, Spalte As Integer, Neben As Integer
Dim sFormat As String, Txt As String
Set TB = Sheets("Etiketten Allgemein")
sFormat = "Pos: [Pos]" & vbLf & _
"Zng. Nr: [Zng]" & vbLf & _
"Stück: [Anz]"
S1 = 2
Spalte = S1
Z1 = 2
Zeile = Z1
Sp = 5
Ze = 7
SpPos = 18
SpZng = 19
SpSt = 22
Neben = 3
LR = TB.Cells(TB.Rows.Count, SpZng).End(xlUp).Row
For i = 2 To LR
For j = 1 To TB.Cells(i, SpSt)
Txt = sFormat
Txt = Replace(Txt, "[Pos]", TB.Cells(i, SpPos))
Txt = Replace(Txt, "[Zng]", TB.Cells(i, SpZng))
Txt = Replace(Txt, "[Anz]", TB.Cells(i, SpSt))
TB.Cells(Zeile, Spalte) = Txt
Spalte = Spalte + Sp
If Spalte = Neben * Sp + S1 Then
Spalte = S1
Zeile = Zeile + Ze
End If
Next j
Next i
End Sub