Sub RemoveEmptyLines()
    Dim para As Paragraph
    For Each para In ActiveDocument.Paragraphs
        If Len(para.Range.Text) <= 1 Then
            para.Range.Delete
        End If
    Next para
End Sub