Adskil tekststreng nedad i celler

Reelt er det jo et alternativ til TextToColumns (TextToRows), men det findes vist ikke :o(

Sub test()
MitRange = Range("A1").Value
Dim Lengde As Long
Lengde = Len(MitRange)
Celle = 1
Do While Lengde > 1
    For I = 1 To 50
        If Mid(MitRange, I, 1) = ";" Then
            Temp = Left(MitRange, I - 1)
            MitRange = Right(MitRange, Lengde - I)
            Lengde = Len(MitRange)
            Celle = Celle + 1
            Range("A" & Celle).Value = Temp
            Exit For
        End If
    Next
    If I = 51 Then Exit Sub
Loop
End Sub

Sub test()
  Dim temp
  Dim l As Long
  temp = Split(Range("a1"), ";")
  l = UBound(temp)
  Range("A2:A" & l + 2) = Application.Transpose(temp)
End Sub

ups akyhne, havde ikke lige opdateret...:-(

Jeg er slet ikke i tvivl om, at begge løsninger virker, nåt de modtages fra så kompetente brugere som jer, så jeg giver gerne point til jeg begge, med en retfærdig fordeling melle 1. og 2. pladsen i responstid :o)

:o)

point gåt ubeskåret til akyhne :-)

Lige en rettelse

If Range("bak").Value = "kompetent" Then
  Range("akyhne").Value = "Ren amatør i forhold til bak"
End if

*lol*
Takker begge