<font color=green>' aktuellen Eintrag nach oben schieben</font>
Dim sTemp As String
 
With lstSorted
  If .ListIndex > 0 Then
    sTemp = .List(.ListIndex)
    .List(.ListIndex - 1) = .List(.ListIndex)
    .List(.ListIndex) = sTemp
    .ListIndex = .ListIndex - 1
  End If
End With

<font color=green>' nach unten schieben</font>
Dim sTemp As String
 
With lstSorted
  If .ListIndex > 0 Then
    sTemp = .List(.ListIndex)
    .List(.ListIndex) = .List(.ListIndex + 1)
    .List(.ListIndex + 1) = sTemp
    .ListIndex = .ListIndex + 1
  End If
End With