Finde bestemt ord i 1. række i tabel og derefter kopier i VBA

Indspil en makro med ctrl+f eller ctrl+b (søg "teori")
åbn makroen, se hvad den gør

Tak for svar.

men indspilling af makro giver ikke helt den ønskede effekt, da jeg kun ønsker at søge i første række af en tabel.

nr2. så giver markering og kopiering af en tabel ikke højde for at tabelstørrelsen kan ændre sig, da den er statisk, fx:

Selection.MoveRight Unit:=wdCharacter, Count:=2, Extend:=wdExtend
Selection.MoveDown Unit:=wdLine, Count:=4, Extend:=wdExtend
Selection.Copy

Falentin: Kan du ikke prøve at forklare lidt mere præcist, hvad du vil opnå. Som jeg læser din beskrivelse, er det kun det fundne ord, du vil kopiere. Det lyder umiddelbart ulogisk af lede efter et bestemt ord for at kopiere det. Når du kan søge efter det, kender du det jo åbenbart allerede. Er det i stedet hele 1. række, du vil kopiere, hvis ordet findes deri eller er det hele tabellen eller ??? Ud fra den makro, du har optaget (#2), kan det tyde på, at det er måske er hele tabellen, du vil kopiere.

Ja, det er vist meget upræcist:-)

Det jeg mener, er at scriptet skal lede ordet teori i 1 række i 1 kolone i alle tabeller i word. Hvis ordet teori er der, skal det kopier hele 2 kolone fra word til excel. (Har ændret lidt i min prioritering)

Som jeg forklarede i mit svar til dig i https://www.computerworld.dk/eksperten/spm/1024927, skal en tabel være ”uniform”, for at man kan tilgå rækker og kolonner via VBA. I makroen nedenfor springes en tabel over, hvis den ikke er uniform.

Du kan have brug for at tilføje fejlhåndtering m.m.

Det er generelt meget bedre at arbejde med Range i stedet for Selection, men da en kolonne i en tabel ikke umiddelbart er tilgængelig som range, har jeg brugt selection her. Når der ændres på selection, skal du hele tiden være opmærksom på, hvad der er markeret og holde styr på det.

Se kommentarerne i koden.

Sub ExamineAllTables_CopyCol2IfSearchedTextFoundInCell1()
    Dim oTable As Table
    Dim oCol As Column
   
    For Each oTable In ActiveDocument.Tables
        If oTable.Uniform = True Then
            With oTable
                'replace XXXX with the text to be found in cell 1 col 1
                If InStr(1, oTable.Cell(1, 1).Range.Text, "XXXX") > 0 Then
                    .Columns(2).Select
                    Selection.Copy
                   
                    'INSERT CODE TO DO SOMETHING WITH THE COPIED COLUMN
                   
                End If
            End With
        End If
    Next oTable
               
End Sub

Super, tak :-)