|
Hallo Leonie,
Also Ich geh jetzt davon aus das in zeile 1 die Überschriften ID und Nummern sind und ab zeile 2 die Id's und die Nummern dazu stehen.
Dann probier mal diesen code aus.
Dim a As Range, Lz As Long, c As Variant, i As Integer, x As Long
Dim Nummer As Variant, ID As Variant
ReDim ID(x)
ReDim Nummer(x)
Lz = Cells(Rows.Count, 2).End(xlUp).Row
If Lz < 2 Then Exit Sub
For Each a In Range("B2:B" & Lz & "")
If Trim(a) <> "" And Trim(a.Offset(0, -1)) <> "" Then
c = Split(a, ";")
For i = LBound(c) To UBound(c)
If Trim(c(i)) <> "" And Replace(c(i), Chr(160), "") <> "" Then
ReDim Preserve ID(x)
ReDim Preserve Nummer(x)
ID(x) = Trim(a.Offset(0, -1))
Nummer(x) = Trim(c(i))
x = x + 1
End If
Next i
End If
Next a
For x = LBound(ID) To UBound(ID)
Cells(x + 2, 1) = ID(x)
Cells(x + 2, 2) = Nummer(x)
Next x
|