Sub BlankLineToSpaceBefore()
' Paul Beverley - Version 26.01.24
' Removes blank lines and adds space before the following paragraph

mySpace = 12

Set rng = ActiveDocument.Content
With rng.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = "^p^p"
  .Wrap = wdFindStop
  .Replacement.Text = ""
  .Forward = True
  .MatchWildcards = False
  .Execute
End With

myCount = 0
Do While rng.Find.Found = True
' If you want to count them...
  myCount = myCount + 1
  rng.MoveStart , 1
  rng.Delete
  rng.MoveStart , 1
  rng.Expand wdParagraph
  rng.ParagraphFormat.SpaceBefore = mySpace
  rng.Collapse wdCollapseStart
  If myCount Mod 20 = 0 Then rng.Select
  rng.Find.Execute
  DoEvents
Loop
MsgBox "Changed: " & myCount

End Sub