|
Hallo,
versuche:
Sub Knoppers()
For i = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
If InStr(Cells(i, "D"), ";") > 0 Then
Tx = Split(Cells(i, "D"), ";")
Range(Cells(i, "A"), Cells(i, "D")).Copy
Range(Cells(i, "A"), Cells(i, "D")).Resize(UBound(Tx)).Insert xlShiftDown, 1
For j = 0 To UBound(Tx)
Cells(i + j, "D") = Tx(j)
Next j
End If
Next i
End Sub
mfg
|