Can't figure this macro out for the life of me...

[pavja2]

So, I am trying to create a VBA macro that selects everything that is
a certain style (i.e. Heading 2) copies it and then pastes the text
into an excel spreadsheet. Is such a macro possible? I know that when
I try to record it using the macro recorder It does not work...This is
what the recorder gives me:

Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles( _
"Heading 2,Heading 2 Char Char2 Char1,Heading 2 Char1 Char
Char1 Char,Heading 2 Char Char Char Char1 Char,Heading 2 Char1 Char
Char Char1 Char Char1,Heading 2 Char Char Char Char Char1 Char
Char,Heading 2 Char2 Char Char Char Char Char,Heading 2 Cha" _
)
Selection.Find.ParagraphFormat.Borders.Shadow = False
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

I have not yet tried to incorporated the copying or excel elements,
but since it doesn't select the neccesary text neither of those would
work anyway. If anyone could tell me how to go about this it would be
much appreciated, I know how to do it manually under the "Format-
styles" menu, but I would like to assign a key-stroke to this
function.

Thanks,

 

[Pesach Shelnitz]

Hi,

The following macro copies each paragraph with the Heading 2 style in the
active document to a cell in the first column of new Excel spreadsheet.

Sub CopyHeading2ToExcel()
Const Error_NotRunning = 429
Dim xlApp As Object
Dim wkBook As Object
Dim myRange As Range
Dim i As Long
Dim width As Long

On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err.Number = Error_NotRunning Then
Set xlApp = CreateObject("Excel.Application")
MsgBox "A new instance of Excel was created."
Else
MsgBox "An open instance of Excel is being used."
End If
On Error GoTo 0
xlApp.Visible = True
Set wkBook = xlApp.Workbooks.Add
wkBook.Activate
Set myRange = ActiveDocument.Range
i = 1
width = wkBook.WorkSheets(1).Columns(1).ColumnWidth
With myRange.Find
.Forward = True
.Wrap = wdFindStop
.Style = wdStyleHeading2
While .Execute = True
wkBook.WorkSheets(1).Cells(i, 1).Value = _
myRange.Text
If Len(myRange.Text) > width Then
width = Len(myRange.Text)
End If
i = i + 1
myRange.Collapse Direction:=wdCollapseEnd
Wend
wkBook.WorkSheets(1).Columns(1).ColumnWidth = width
End With
Set xlApp = Nothing
Set wkBook = Nothing
Set myRange = Nothing
End Sub