I found a possible solution:
Public Sub Replace4()
Dim startRow As Integer
startRow = Selection.Range.Information(wdEndOfRangeRowNumber)
With Selection.Find
.Text = "long"
Do While .Execute
If Selection.Range.Information(wdEndOfRangeRowNumber) <> startRow Then
Exit Do
End If
If Selection.Range.ListFormat.ListType <> wdListBullet Then
Selection.Range.Text = "short"
' Chr(11)
' Chr (13) + Chr(10)
' rDcm.Collapse wdCollapseEnd
End If
Loop
End With
End Sub
I also found a cleaner (to my eyes) solution to the original problem. I.e. replace paragraphs with line breaks inside the selection. It might be useful for someone in the future:
Public Sub Replace5()
Dim rngCurr As Range
Dim rngNext As Range
For i = 1 To Selection.Range.Paragraphs.Count - 1
Set rngCurr = Selection.Range.Paragraphs(i).Range
Set rngNext = Selection.Range.Paragraphs(i + 1).Range
If rngCurr.ListFormat.ListType <> wdListBullet Then
If rngNext.ListFormat.ListType <> wdListBullet Then
rngCurr.Characters.Last = Chr(11)
End If
End If
Next i
End Sub