Array geht nicht in die Zellen

With Worksheets("OPS")
ReDim arrTmp(.UsedRange.Rows.Count - 1)
For i = 2 To .UsedRange.Rows.Count
If InStr(.Cells(i, 6), "-") = 0 Then
Links = Left(.Cells(i, 6), 1)
Mitte = Mid(.Cells(i, 6), 2, 3)
Rechts = Mid(.Cells(i, 6), 5)
Select Case Rechts
Case Is = ""
Neu = Links & "-" & Mitte
Case Is  ""
Neu = Links & "-" & Mitte & "." & Rechts
End Select
Else
Neu = .Cells(i, 1)
End If
arrTmp(i - 2) = Neu
Next i
  .Cells(2, 6).Resize(i - 2) = arrTmp
End With