Split en streng og lav en liste

Prøv denne kode
Marker alle celler med Kode ag afdeling og kør så makroen.
Resultatet blive placeret i kolonne F og G

Sub test()
    Dim x As Long, y As Long
    Dim c As Range, rg As Range
    Dim t As Variant
    ReDim TheArray(1, 1000)
   
    Set rg = Selection
    For Each c In Range(rg.Columns(1).Address)

        t = Split(c.Offset(0, 1), "/")
       
        For x = 0 To UBound(t)
            TheArray(0, y) = c
            If Len(t(x)) >= 1 Then
            TheArray(1, y) = t(x)
            y = y + 1
            ' step up array size by 1000
            If y Mod 1000 = 0 Then ReDim Preserve TheArray(1, UBound(TheArray, 1) + 1000)
            End If
        Next
       
    Next
   
    Range("F1").Resize(y, 2) = Application.Transpose(TheArray)
   
End Sub

Perfect! Det virker helt efter hensigten! Mange tak

Godt at det virker :-)
Så får du lige et svar.

saa fik jeg dig lige skubbet over 100.000 point! :-)
Takker for hjaelpen

takker :-)