ich habe jetzt mal der übersichtshalber die das ganze script hier

die anderen 3 listboxen kannst du ignorieren, da das prinzip ja später das gleich bleibt, wie bei der wo ich gerade bin.

Private Sub CommandButton1_Click()
    
    Dim oExcelApp As Object
    Dim oExcelWorkbook As Object
    Dim lZeile As Long
    
    'ActiveDocument.Bookmarks("KK9").CheckBox.Value = CheckBox1.Value
 
'      'Nur wenn ein Eintrag in der Liste markiert ist, wird das Makro ausgeführt
'      If ListBox1.ListIndex >= 0 Then

          'Zuerst wird die Excel Datei geöffnet
          Set oExcelApp = CreateObject("Excel.Application")
          Set oExcelWorkbook = oExcelApp.Workbooks.Open(ThisDocument.Path & DatenBezug)
      
'        Dim meineBM As Range
'        Dim i As Range
      
        meineBM = Array("TM_E_Firma", "TM_E_StrHnr", "TM_E_PLZ", "TM_E_Ort", "TM_E_Tel", "TM_E_Fax", "TM_E_Mail", "TM_E_KD")
         
        lZeile = 2 'Wir starten in Zeile 2, da in der ersten Zeile überschriften stehen
          With oExcelWorkbook.Sheets(DatEmpfaenger)
              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 7
                        'Fehlerbehandlung falls BM nicht existiert fehlt, jetzt wird da einfach nur nix gemacht
                        If ActiveDocument.Bookmarks.Exists(meineBM(i)) Then
                            Set TMRange = ActiveDocument.Bookmarks(meineBM(i)).Range
                            TMRange = CStr(.Cells(lZeile, i + 3).Value)
                            ActiveDocument.Bookmarks.Add meineBM(i), TMRange
                            Set TMRange = Nothing
                        End If
                         
                      Next i
                       
                      Exit Do
                  End If
                  lZeile = lZeile + 1
              Loop
          End With
          
'      Else
'          MsgBox "ListBox1 prüfen!", _
'              vbInformation + vbOKOnly, "HINWEIS!"
'          Exit Sub
'      End If
'
'      If ListBox2.ListIndex >= 0 Then
          
          lZeile = 2 'Wir starten in Zeile 2, da in der ersten Zeile überschriften stehen
          With oExcelWorkbook.Sheets(DatAbsender)
              Do While .Cells(lZeile, 1) <> ""
                  'Wenn der Eintrag der Listbox mit dem Namen in der Adresstabelle
                  'übereinstimmt, dann werden die Textmarken gefüllt!
                  If ListBox2.Text = CStr(.Cells(lZeile, 1).Value) Then
                      'Eintrag gefunden, Textmarken füllen
                      ActiveDocument.Bookmarks("TM_Vorname").Range = _
                          CStr(.Cells(lZeile, 2).Value)
                      ActiveDocument.Bookmarks("TM_Vorname2").Range = _
                          CStr(.Cells(lZeile, 2).Value)
                      ActiveDocument.Bookmarks("TM_Nachname").Range = _
                          CStr(.Cells(lZeile, 3).Value)
                      ActiveDocument.Bookmarks("TM_Nachname2").Range = _
                          CStr(.Cells(lZeile, 3).Value)
                      ActiveDocument.Bookmarks("TM_StrHnr").Range = _
                          CStr(.Cells(lZeile, 4).Value)
                      ActiveDocument.Bookmarks("TM_PLZ").Range = _
                          CStr(.Cells(lZeile, 5).Value)
                      ActiveDocument.Bookmarks("TM_Ort").Range = _
                          CStr(.Cells(lZeile, 6).Value)
                      ActiveDocument.Bookmarks("TM_Tel").Range = _
                          CStr(.Cells(lZeile, 7).Value)
                      ActiveDocument.Bookmarks("TM_Mail").Range = _
                          CStr(.Cells(lZeile, 8).Value)
                      Exit Do
                  End If
                  lZeile = lZeile + 1
              Loop
          End With
          
'      Else
'          MsgBox "ListBox2 prüfen!", _
'              vbInformation + vbOKOnly, "HINWEIS!"
'          Exit Sub
'      End If
'
'      If ListBox3.ListIndex >= 0 Then
          
          lZeile = 2 'Wir starten in Zeile 2, da in der ersten Zeile überschriften stehen
          With oExcelWorkbook.Sheets(DatTxtBausteine)
              Do While .Cells(lZeile, 1) <> ""
                  'Wenn der Eintrag der Listbox mit dem Namen in der Adresstabelle
                  'übereinstimmt, dann werden die Textmarken gefüllt!
                  If ListBox3.Text = CStr(.Cells(lZeile, 1).Value) Then
                      'Eintrag gefunden, Textmarken füllen
                      ActiveDocument.Bookmarks("TM_Betreff").Range = _
                          CStr(.Cells(lZeile, 3).Value)
                      Exit Do
                  End If
                  lZeile = lZeile + 1
              Loop
          End With
          
'      Else
'          MsgBox "ListBox3 prüfen!", _
'              vbInformation + vbOKOnly, "HINWEIS!"
'          Exit Sub
'      End If
'
'      If ListBox4.ListIndex >= 0 Then
          
          lZeile = 2 'Wir starten in Zeile 2, da in der ersten Zeile überschriften stehen
          With oExcelWorkbook.Sheets(DatTxtBausteine2)
              Do While .Cells(lZeile, 1) <> ""
                  'Wenn der Eintrag der Listbox mit dem Namen in der Adresstabelle
                  'übereinstimmt, dann werden die Textmarken gefüllt!
                  If ListBox4.Text = CStr(.Cells(lZeile, 1).Value) Then
                      'Eintrag gefunden, Textmarken füllen
                      ActiveDocument.Bookmarks("TM_Inhalt").Range = EinfTxtBox.Text
                      Exit Do
                  End If
                  lZeile = lZeile + 1
              Loop
          End With
         
          oExcelWorkbook.Close False
          oExcelApp.Quit
      
'      Else
'          MsgBox "Alle ListBoxen prüfen!", _
'              vbInformation + vbOKOnly, "HINWEIS!"
'          Exit Sub
'      End If

    'ActiveDocument.Bookmarks("TM_Inhalt").Range = EinfTxtBox.Text
    
    Set oExcelWorkbook = Nothing
    Set oExcelApp = Nothing
    
    'CheckBox Unterschrift
    If CheckBox1.Value = True Then
        Call GrafikEinfügen
    End If
    
    Unload Me
End Sub