Sub Macro2()
Selection.HomeKey Unit:=wdStory
y = ActiveDocument.Tables.Count
For i = 1 To y
Selection.GoTo What:=wdGoToTable, Which:=wdGoToNext, Count:=1, Name:=""
Selection.Tables(1).Select
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
x = Selection.Characters.Count
If x = 1 And Selection = Chr(13) Then Selection.Delete
Next
End Sub