From your description, it appears that you need to add a second loop to loop through the tables. Maybe something like
Option Explicit
Sub test()
Dim oWord As Object
Dim oDoc As Object
Dim oTable As Object
Dim oCell As Object
Dim sPath As String
Dim sFile As String
Dim r As Long
Dim c As Long
Dim Cnt As Long
Application.ScreenUpdating = False
On Error Resume Next
Set oWord = GetObject(, "Word.Application")
If Err Then
Set oWord = CreateObject("Word.Application")
End If
On Error GoTo 0
sPath = "C:\Documents\" 'change the path accordingly
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
sFile = Dir(sPath & "*.doc")
r = 2 'starting row
c = 1 'starting column
Cnt = 0
Do While Len(sFile) > 0
Cnt = Cnt + 1
Set oDoc = oWord.Documents.Open(sPath & sFile)
If oDoc.tables.Count > 0 Then
For Each oTable In oDoc.tables
For Each oCell In oTable.Range.Cells
Cells(r, c).value = Replace(oCell.Range.Text, Chr(13) & Chr(7), "")
c = c + 1
Next oCell
Next oTable
r = r + 1
c = 1
End If
oDoc.Close SaveChanges:=False
sFile = Dir
DoEvents
Loop
Application.ScreenUpdating = True
If Cnt = 0 Then
MsgBox "No Word documents were found...", vbExclamation
End If
End Sub
I take it we can assume the cell processing is what you require?