Mehrere Werte in 2 Spalten auftrennen

[AlterDresdner]

Hallo,
ein QuickAndDirty-Makro
Sub Trennen()
Const Trenner = "|"
Dim W1 As String, W2 As String, i, spalte As Long
Dim A As String
  W1 = Range("A1")
  W2 = Range("B1")
  spalte = 1
  Do
    i = InStr(1, W1, Trenner)
    If i > 0 Then
      A = Trim(Left(W1, i - 1))
      W1 = Mid(W1, i + 1)
    Else
      A = Trim(W1)
      W1 = ""
    End If
    Cells(1, spalte) = A
    i = InStr(1, W2, Trenner)
    If i > 0 Then
      A = Trim(Left(W2, i - 1))
      W2 = Mid(W2, i + 1)
    Else
      A = Trim(W2)
      W2 = ""
    End If
    Cells(2, spalte) = A
    spalte = spalte + 1
  Loop Until Len(Trim(W1)) = 0
End Sub
Hätte ich mir gespart, wenn ich Calderons Post gelesen hätte...