Please help where to modify the macro
Hi All,
I have applied the below macro in a word document.
The macro should extract all the name of the person into a Excel file, however, it shows Run-time error '5941', not sure how to resolve this, May I request you to check and provide help on this please.
The output in the Excel file would be
AAA
BBB
DDD
XXX
ZZZ
KKK
RRR
I have attached the document herewith
Sub CopyNamesToExcel()
Dim oTable As Table
Dim oRng As Range
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Dim xlCell As Object
Dim i As Integer, j As Integer
Dim sName As String
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err Then
Set xlApp = CreateObject("Excel.Application")
End If
On Error GoTo 0
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Sheets(1)
xlApp.Visible = True
'Set xlCell = xlSheet.Range("A1")
'xlCell.value = "Name"
'j = 2
j = 1
For Each oTable In ActiveDocument.Tables
Set oRng = oTable.Cell(1, 2).Range
oRng.End = oRng.End - 1
If InStr(1, oRng.Text, "NAMES OF PERSON") > 0 Then
sName = Replace(oRng.Text, "NAMES OF PERSON", "")
sName = Replace(sName, Chr(13), "")
Set xlCell = xlSheet.Range("A" & j)
xlCell.value = Trim(sName)
j = j + 1
End If
Next oTable
End Sub
|