Sub Macro()

'This Section Opens up the document<<<<<<<<<<<<<'
'################################################# ########'
Dim wdApp As Word.Application, wdDoc As Word.Document
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number < 0 Then 'Word isn't already running
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
Set wdDoc = wdApp.Documents.Open("Doc.doc")
wdApp.Visible = True
wdApp.Activate
'################################################# ########'

'This Section Finds the Table<<<<<<<<<<<<<'
'################################################# ########'

wdApp.Selection.Find.ClearFormatting
With wdApp.Selection.Find
.Text = "what i'm searching for"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
wdApp.Selection.Find.Execute
wdApp.Selection.MoveUp Unit:=wdLine, Count:=1
wdApp.Selection.MoveDown Unit:=wdLine, Count:=172,
Extend:=wdExtend
wdApp.Selection.MoveUp Unit:=wdLine, Count:=2, Extend:=wdExtend
wdApp.Selection.Copy
wdApp.Documents.Close
wdApp.Visible = False
'################################################# ########'

'This Selection Starts Excel<<<<<<<<<<<<<'
'################################################# ########'
Dim exApp As Excel.Application
On Error Resume Next
Set exApp = GetObject(, "Excel.Application")
If Err.Number < 0 Then 'Excel isn't already running
Set exApp = CreateObject("Excel.Application")
End If
On Error GoTo 0
'################################################# ########'

'This Selection Creates a new Sheet<<<<<<<<<<<<<'
'################################################# ########'

Dim wSht As Worksheet
Dim shtName As String
shtName = ("WordStuff")
For Each wSht In Worksheets
If wSht.Name = shtName Then
MsgBox "Sheet already exists...Make necessary " & _
"corrections and try again."
Exit Sub
End If
Next wSht
Sheets.Add.Name = shtName
'################################################# ########'


'This Selection Pastes the table from Word<<<<<<<<<<<<<'
'################################################# ########'
exApp.ActiveSheet.Paste
exApp.ActiveCell.Activate
exApp.Columns("B").Select

'################################################# ########'

End Sub



From this point how would I store the strings in the column B to an
array?


Thanks