Dim MyFiles As String
Sub Get_Os()
Dim info As System
Dim myos
    myos = Application.System.OperatingSystem
    If myos = "Macintosh" Then
    ''' system is Mac ''
        Call GetTextFilesOnMac
    Else
    ''' system is PC
        Call ImportWordTable
    End If
End Sub
Sub ImportWordTable()
    Dim wdDoc As Object
    Dim wdFileName As Variant
    Dim TableNo As Integer 'table number in Word
    Dim wordRow As Long 'row index in Word
    Dim wordCol As Integer 'column index in Word
    Dim ExcelRow As Long 'row index in Excel
    Dim ExcelCol As Integer 'column index in Excel
    Dim ColToStart As Integer
    
    wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , _
    "Browse for file containing table to be imported")
    If wdFileName = False Then Exit Sub '(user cancelled import file browser)
    Set wdDoc = GetObject(wdFileName) 'open Word file
    With wdDoc
        If wdDoc.Tables.Count = 0 Then
            MsgBox "This document contains no tables", _
                vbExclamation, "Import Word Table"
        Else
            ExcelRow = 0
            Sheets.Add After:=Sheets(Worksheets.Count)
            ColToStart = 1
            For TableNo = 1 To wdDoc.Tables.Count
                With .Tables(TableNo)
    'copy cell contents from Word table cells to Excel cells
                    If TableNo > 1 Then
                        ColToStart = 2
                    End If
                    For wordCol = ColToStart To .Columns.Count
                        ExcelCol = ExcelCol + 1
                        
                        For ExcelRow = 1 To .Rows.Count
                            On Error Resume Next
                            ActiveSheet.Cells(ExcelCol, ExcelRow) = WorksheetFunction.Clean(.Cell(ExcelRow, wordCol).Range.Text)
                            On Error GoTo 0
                        Next ExcelRow
                    Next wordCol
                End With
            Next TableNo
        End If
    End With
    Set wdDoc = Nothing
End Sub
Sub GetTextFilesOnMac()
Dim vFileName As Variant
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim wordRow As Long 'row index in Word
Dim wordCol As Integer 'column index in Word
Dim ExcelRow As Long 'row index in Excel
Dim ExcelCol As Integer 'column index in Excel
Dim ColToStart As Integer
    'Call the function to return the files
   vFileName = Select_File_Or_Files_Mac

    'If it's empty then the user cancelled
    'If IsEmpty(vFileName) Then Exit Sub
    Documents.Open fileName:=MyFiles, ConfirmConversions:=False, _
         ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
        WritePasswordTemplate:="", Format:=wdOpenFormatAuto
        '''''''''''''''''''''
    wdDoc = ActiveDocument
With wdDoc
        If wdDoc.Tables.Count = 0 Then
            MsgBox "This document contains no tables", _
                vbExclamation, "Import Word Table"
        Else
            ExcelRow = 0
            'Sheets.Add After:=Sheets(Worksheets.Count)
            ColToStart = 1
            For TableNo = 1 To wdDoc.Tables.Count
                With .Tables(TableNo)
    'copy cell contents from Word table cells to Excel cells
                    If TableNo > 1 Then
                        ColToStart = 2
                    End If
                    For wordCol = ColToStart To .Columns.Count
                        ExcelCol = ExcelCol + 1
                        
                        For ExcelRow = 1 To .Rows.Count
                            On Error Resume Next
                            ActiveSheet.Cells(ExcelCol, ExcelRow) = WorksheetFunction.Clean(.Cell(ExcelRow, wordCol).Range.Text)
                            On Error GoTo 0
                        Next ExcelRow
                    Next wordCol
                End With
            Next TableNo
        End If
    End With
    Set wdDoc = Nothing
   

End Sub

Function Select_File_Or_Files_Mac() As Variant
    'Uses AppleScript to select files on a Mac
    Dim MyPath As String, MyScript As String, MySplit As Variant

    'Get the documents folder as a default
    On Error Resume Next
    MyPath = MacScript("return (path to documents folder) as String")

    'Set up the Apple Script to look for text files
    MyScript = "set applescript's text item delimiters to "","" " & vbNewLine & _
            "set theFiles to (choose file of type " & " {""org.openxmlformats.wordprocessingml.document""} " & _
            "with prompt ""Please select a file or files"" default location alias """ & _
            MyPath & """ multiple selections allowed true) as string" & vbNewLine & _
            "set applescript's text item delimiters to """" " & vbNewLine & _
            "return theFiles"

    'Run the Apple Script
    MyFiles = MacScript(MyScript)
    On Error GoTo 0

End Function