Sub ExamineSpecific()

'Dim bRun As Boolean

'Use our workbook
Dim wbk As Workbook
Dim wks As Worksheet
Set wbk = ThisWorkbook
Set wks = wbk.Worksheets(3)
Set wps = wbk.Worksheets(2)

wbk.Activate
wks.Activate
wks.Range("A1").Select
Selection.End(xlDown).Select
With ActiveCell
    endrow = .Row
End With


'Initialize variables
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdCell As Word.Cell
Set wdApp = New Word.Application
Dim lTable, lRow, lColumn As Long



Dim MyDialog As FileDialog, GetStr(1 To 100) As String '100 files is the maximum applying this code
On Error Resume Next
Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
With MyDialog
.Filters.Clear
.Filters.Add "All WORD File ", "*.doc*", 1
.AllowMultiSelect = True
i = 1
If .Show = -1 Then
For Each stiSelectedItem In .SelectedItems
GetStr(i) = stiSelectedItem
i = i + 1
Next
i = i - 1
End If
'Application.ScreenUpdating = False

For j = 1 To i Step 1

Set wdDoc = wdApp.Documents.Open(GetStr(j))
wdApp.Visible = True

For r = 1 To endrow Step 1
    lTable = wps.Cells(r, 1).Value
    lRow = wps.Cells(r, 2).Value
    lColumn = wps.Cells(r, 3).Value
    wks.Cells(r, j + 1) = Left(wdDoc.Tables(lTable).Cell(lRow, lColumn).Range.Text, Len(wdDoc.Tables(lTable).Cell(lRow, lColumn).Range.Text) - 1)
Next r
wks.Cells(r + 1, j + 1) = wdDoc.Name
wdDoc.Close SaveChanges:=False
Set wdCell = Nothing
Set wdDoc = Nothing
Next j
End With

Set wdApp = Nothing

Application.ScreenUpdating = True


End Sub