Copy and Paste Heading and Body text

[Austinjs0102]

I have a 150 page word file for work that i need to go through. What i would like to do is automate this since i rather not copy and paste all 150 pages.
There are headings 1 2 and 3 in this file. Both Headings 2 and 3 may have body text.
What i need to do is copy the Heading 2 and the body text that follows it and paste it in an excel document for some comparison.

Example

Word
heading 1
heading 2
Body text

Excel
A1 = Title b1 = Description
Heading 2 will goto A1
Body text will goto B1

Here is a macro i have now that will identify if its a Body or Heading style. Where can i go from this to have it copy and paste. By the way i am new to coding VBA

Sub EditFindLoopExample()
'This example inserts "Tip: " at the beginning of
' every paragraph formatted with the Heading 3 style.
    With ActiveDocument.Content.Find
        .ClearFormatting
        .Style = wdStyleBodyText
        'The Do...Loop statement repeats a series of
        ' actions each time this style is found.
        Do While .Execute(Forward:=True, Format:=True) = True
                With .Parent
                    'If the found text is the last
                    ' paragraph in the document...
                    If .End = ActiveDocument.Content.End Then
                        .StartOf Unit:=wdParagraph, Extend:=wdMove
                        .InsertAfter "Tip: "
                        Exit Do
                    'If the found text is *not* the last
                    ' paragraph in the document...
                    Else
                        .
                        .StartOf Unit:=wdParagraph, Extend:=wdMove
                        .InsertAfter "Here:  "
                        .Move Unit:=wdParagraph, Count:=1
                    End If
                End With
        'Goes back to the beginning of the Do...Loop statement.
        Loop
    End With
End Sub

[Austinjs0102]

So i have changed this a bit. could use some help here. Here is some details.
Id like to take a 150 page document and extract Heading 2, Heading 3, and the body text. here is what i need for it to to.

If it finds heading 2 then copy it to Cell A1 in excel, then check if there is body text If there is body text then Copy the body text to Cell B1, if there is no body text not then check if Heading 3 is underneath, if heading 3 is there then copy Heading 3 to the next cell in A. if body text is there then copy the body text to next Cell in B, if there is no body then goto the next line and restart the loop.

Basically i am trying to keep the body text of Heading 2 with it and the body text of heading 3 with it also.

If anyone knows how to help me i would appreciate it. I am working in VBA and not sure if i am able to Copy this data to excel.

Sub cAp()
'
' Macro1 Macro
'
'
Do While _
    Selection.Find.Style = ActiveDocument.Styles("Heading 2")
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Copy
    Loop
    
End Sub