Slette linjer i word udfra kode i Excel

JEg har denne her kode som starter en skabelonfil op i word og indsætter en masse tekster og tal udfra nogle bookmarks.

Det kører faktisk meget godt.
Når koden er færdig med at indsætte er der nogle linjer som er tomme.
Dem vil jeg gerne have slettet hvis der er mere end 3 ENTER efter hinanden.

Jeg har fundet en lille kode der gør det når jeg kører fra Word.
Den ser således ud.

Do
    With Selection.Find
            .Text = "^p^p^p"
            .Replacement.Text = "^p"
            .Forward = True
            .Wrap = wdFindContinue
    End With
    Loop Until Selection.Find.Execute(Replace:=wdReplaceAll) = False

JEg vil meget gerne have den til at køre indefra min kode i excel som starter det hele op og flette informationerne, men jeg kan ikke få den til at "forstå" at den skal løbe koden igennem i word og ikke i excel.

JEg vil mene at det har noget med at fortælle at det er "gwdDoc", men kan ikke hitte ud af det.

Er der nogen der kan se hvor jeg misser detaljen :-)

Den samlede kode ser således ud:


Sub Word_export_test()
    Dim sFileToOpen As String
    Dim bWordStartedByMe As Boolean
    Dim resultat, aktiver, egenkapital, udbytte
   
    bWordStartedByMe = False
    sFileToOpen = "c:\data\flettefil.doc"
    Application.ScreenUpdating = False
    Sheets("Stam").Range("revprotokol_til") = Sheets("Stam").Range("revprotokol_fra") + 2
    On Error GoTo ShitHappens
   
    ' Bruger Word hvis Word er åben ellers fejl
    Set gwdApp = GetObject(, "Word.Application")
    gwdApp.Visible = True
    gwdApp.Activate
   
    Set gwdDoc = gwdApp.Documents.Open(Filename:=sFileToOpen)
       
    gwdDoc.Bookmarks("bm01").Range.Text = "Velkommen"
    gwdDoc.Bookmarks("bm02").Range.Text = "klik her"
    'osv.
   
   

   
    '**** Denne kodestump skal gerne køre ude i word-dokumentet
    '**** men jeg kan ikke få den til det.
   
    Do
    With Selection.Find
            .Text = "^p^p^p"
            .Replacement.Text = "^p"
            .Forward = True
            .Wrap = wdFindContinue
    End With
    Loop Until Selection.Find.Execute(Replace:=wdReplaceAll) = False

    '**** Slut på koden som skal køres i word
   
 

 
   
Application.ScreenUpdating = True
GoTo ClearUp
   
ShitHappens:
    Select Case Err.Number
        Case 429
            ' Hvis Word ikke er startet
            Set gwdApp = CreateObject("Word.Application")
            bWordStartedByMe = True
            Resume Next
        Case Else
            Err.Clear
    End Select

ClearUp:
    Set gwdDoc = Nothing
    Set gwdApp = Nothing
End Sub