Přenos Dat od velkého souboru aplikace Excel na více tabulek v dokumentu aplikace word

Pro první přístup, můžete použít tento kód v MS Word, kam chcete naplnit tabulky. Kód není optimalizován a kontrolu chyb je vynechán. Očekává pojmenovanou oblast 'MyData' existuje a obsahuje přesně tři sloupce [společnost, jméno1, jméno2]

'Add reference to the 'Microsoft Excel 16.0 Object Library' is required

Sub FillTablesFromExcel()
    
    Dim doc As Word.Document
    Set doc = ThisDocument
    
    Dim data
    data = ReadDataFromExcel
    
    Dim t As Word.Table
    For Each t In doc.Tables
        If t.Columns.Count <> 3 Then Exit For
        
        Dim r As Word.Row
        For Each r In t.Rows
            Dim txt As String
            txt = r.Cells(1).Range.Text
            company = Trim(Left(txt, Len(txt) - 2))
            
            For i = 1 To UBound(data)
                comp = data(i, 1)
                name1 = data(i, 2)
                name2 = data(i, 3)
                
                If company = comp Then
                    r.Cells(2).Range.Text = name1
                    r.Cells(3).Range.Text = name2
                End If
            Next
        Next
    Next

End Sub

Function ReadDataFromExcel()

    Dim xlsWorkbook As Excel.Workbook
    Set xlsWorkbook = Excel.Workbooks.Open("C:\Path\To\The\File.xlsx", ReadOnly:=True)
    
    Dim xlsSheet As Excel.Worksheet
    Set xlsSheet = xlsWorkbook.Sheets(1)
    
    Dim dataRange As Excel.Range
    Set dataRange = xlsSheet.Range("MyData")
    
    Value2 = dataRange.Value2
    
    Call xlsWorkbook.Close(False)
    ReadDataFromExcel = Value2
End Function