GIbt da mehrere Möglichkeiten. Man könnte es als zweidimensionales Array anlegen (praktisch wie ein Tabelle). Ich würde zum Anfang und da man den Wert nur einmal braucht einfach ein zweites Array mit den Spaltenindizes anlegen und das bei .cells(lZeile, neuesArray) eintragen. Sollte dann so wie unten aussehen. HAt dann auch den Vorteil, du musst beim Ändern nicht schauen, wo es genau im Code ist, sondern einfach nur im Array eine Zahl ändern. Damit es nicht unübersichtlich wird poste ich gleich noch eine Version mit einem Array. Musst du dann mal schauen, was besser ist und übersichtlicher. VG

Dim AbsBM As Variant
Dim spaltenNR As Variant

spaltenNR = Array(2, 2, 3, 3, 4, 5, 6, 7, 8)
AbsBM = Array("TM_Vorname", "TM_Vorname2", "TM_Nachname", "TM_Nachname2", "TM_StrHnr", "TM_PLZ", "TM_Ort", "TM_Tel", "TM_Mail")
 
lZeile = 2 'Wir starten in Zeile 2, da in der ersten Zeile überschriften stehen
With oExcelWorkbook.Sheets(DatAbsender)
    Do While .Cells(lZeile, 2) <> ""
        'Wenn der Eintrag der Listbox mit dem Namen in der Adresstabelle
        'übereinstimmt, dann werden die Textmarken gefüllt!
        If ListBox1.Text = CStr(.Cells(lZeile, 1).Value) Then
            'Eintrag gefunden, Textmarken füllen
           'deine 8 Bookmarks würde ich in der SChleife abarbeiten
            For i = 0 To 8
              'Fehlerbehandlung falls BM nicht existiert fehlt, jetzt wird da einfach nur nix gemacht
              If ActiveDocument.Bookmarks.Exists(AbsBM(i)) Then
                  Set TMRange = ActiveDocument.Bookmarks(AbsBM(i)).Range
                  TMRange = CStr(.Cells(lZeile, spaltenNR(i)).Value)
                  ActiveDocument.Bookmarks.Add AbsBM(i), TMRange
                  Set TMRange = Nothing
              End If
                
            Next i
              
            Exit Do
        End If
        lZeile = lZeile + 1
    Loop
End With