Sub ProcessRanges()
Dim oStory As Range
   For Each oStory In ActiveDocument.StoryRanges
        DeleteEmptyRows oStory
        If oStory.StoryType <> wdMainTextStory Then
            While Not (oStory.NextStoryRange Is Nothing)
                Set oStory = oStory.NextStoryRange
                DeleteEmptyRows oStory
            Wend
        End If
    Next oStory
    Set oStory = Nothing
End Sub