Hvordan hentes specifik data fra excel til word

VBA kan gøre det. Du er velkommen til at sende en kopi/model af begge filer. @-adresse under min profil.

og så velkommen til Eksperten..

Rem Reference til Microsoft Excel er sat i VBA (Alt+F11/Tools/References/Microsoft Excel 12.0 Object Library
Rem VBA-koden anbringes i VBA / ThisDocument
Rem ========================================
Const stiTilPriser = "C:\Users\peter\Desktop\ChristianLeu\Priser.xls"          '<-- ændres
Const prisArkNavn = "InvenSalesPriceList"
Dim xlsPriser

Dim antalTabeller As Integer, antalRækker As Integer
Public Sub HentPriser()
    HouseKeeping
       
    TraverserDokument

    lukPriser
    MsgBox "Prissætning er afsluttet"
End Sub
Private Sub HouseKeeping()
    Set xlsPriser = CreateObject("Excel.Application")
    xlsPriser.Workbooks.Open stiTilPriser
       
    antalTabeller = ActiveDocument.Tables.Count
    antalRækker = ActiveDocument.Tables(1).Rows.Count
End Sub
Private Sub TraverserDokument()
Dim ræk, kolonne2, vareNr As Long, pris, p1, p2
Dim toPriser As Variant
On Error GoTo fejl
    Application.ScreenUpdating = False
   
    For ræk = 1 To antalRækker
        With ActiveDocument.Tables(1)
            kolonne2 = .Cell(ræk, 2)
            If Len(kolonne2) > 8 Then
                toPriser = Split(kolonne2, Chr(13))
                p1 = toPriser(0)
                p2 = toPriser(1)
                               
                pris1 = findPris(p1)
                pris2 = findPris(p2)
                pris = Format(pris1, "###,###.00") & Chr(13) & Format(pris2, "###,###.00")
                .Cell(ræk, 5).Select
                Selection.Text = pris
            Else
                vareNr = Left(kolonne2, Len(kolonne2) - 2)  'blank + slutcelle fjernes
                pris = findPris(vareNr)
                .Cell(ræk, 5).Select
                Selection.Text = Format(pris, "###,###.00")
            End If
        End With
    Next ræk
    Exit Sub
   
fejl:
    MsgBox "Fejl erkendt i tabelrække: " & CStr(ræk)
    lukPriser
End Sub
Private Sub lukPriser()
    With xlsPriser
        .Application.Quit
    End With
   
    Set xlsPriser = Nothing
End Sub
Private Function findPris(vareNr)
Dim række As Long
    With xlsPriser.Range("A1:A65000")
        Set c = .Find(vareNr, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            række = c.Row
        Else
            række = 0
        End If
    End With
       
    If række <> 0 Then
        findPris = xlsPriser.Range("C" & række)
    Else
        findPris = 0
    End If
End Function

Det ser rigtig spændende ud!

Kan koden ændres lidt så den kan køre med object library 11 istedet?

Ja - du følge blot det anført øverst:
Rem Reference til Microsoft Excel er sat i VBA (Alt+F11/Tools/References/Microsoft Excel 12.0 Object Library)

Alle referencer er i alfabetisk orden - så du fjerner blot flueben for 12.0 - søg ned til Microsoft Excel 11.0 Object Library og sætter flueben i denne.

OK - gem og luk VBA-vinduet. Gem filen og start op igen..

Det er bare mig der glemte fjerne den der stod 'Missing' på.

Har et spørgsmål mere.

Den henter ikke data på rækker med mere end 2 numre.

Har sendt dig en mail.

De 2 rækker var hvad jeg umiddelbart kunne se af eksemplerne fra i går.

Inden vi evt. går videre synes jeg du skal afslutte indeværende tråd..

Så afslutter vi da bare tråden.

Mange tak for løsningen.