Hab ich dir doch geschrieben, den angegebenen Dateipfad durch deinen ersetzen. Das Wort Tabelle1$ hinter FROM durch den Namen deiner Tabelle ersetzen. Am besten auch mit $ hinten dran. Und natürlich die Feldnamen "Datei" und "Name" durch die deinen ersetzen. Die zu ersetzenden Sachen sind sogar automatisch hellblau markiert im Code. Insofern sollte das doch kein Problem sein. Aber bitte. Hier noch ein Versuch mit deinen Daten. Da du den Dateinamen nicht verraten hast, musst du natürlich das Wort Dateiname noch ersetzen.

Sub Etikett_Erstellen()
  Dim doc As Document, cl As Cell, i As Long
  Set doc = Application.MailingLabel.CreateNewDocumentByID(LabelId:="805957182")
  doc.MailMerge.OpenDataSource Name:="C:\Test\Dateiname.xlsx", SQLStatement:="SELECT * FROM `Tabelle1$`"
  ActiveWindow.View.ShowFieldCodes = True
  For Z = 1 To 8
    For s = 1 To 5 Step 2
      Set cl = doc.Tables(1).Cell(Z, s)
        With cl.Tables.Add(Range:=cl.Range, NumRows:=1, NumColumns:=2)
          For i = 1 To 8
            .Borders(-i).LineStyle = wdLineStyleNone
          Next i
          .TopPadding = CentimetersToPoints(0)
          .BottomPadding = CentimetersToPoints(0)
          .LeftPadding = CentimetersToPoints(0)
          .RightPadding = CentimetersToPoints(0)
          .Spacing = 0
          .Rows.HeightRule = wdRowHeightExactly
          .Rows.Height = cl.Height
          doc.Fields.Add Range:=StartRange(.Cell(1, 1).Range), Text:="DISPLAYBARCODE ""Hier"" QR"
          doc.MailMerge.Fields.Add Range:=PartRange(.Cell(1, 1).Range, "Hier"), Name:="Token"
          doc.MailMerge.Fields.Add Range:=.Cell(1, 2).Range, Name:="Username"
          EndRange(.Cell(1, 2).Range).InsertAfter vbNewLine
          doc.MailMerge.Fields.Add Range:=EndRange(.Cell(1, 2).Range), Name:="Voller Name"
          .Cell(1, 1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
          .Cell(1, 1).VerticalAlignment = wdCellAlignVerticalCenter
          .Cell(1, 2).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
          .Cell(1, 2).VerticalAlignment = wdCellAlignVerticalCenter
          If Not (Z = 1 And s = 1) Then doc.Fields.Add Range:=StartRange(.Cell(1, 1).Range), Text:="NEXT "
        End With
        'Stop
    Next s
  Next Z
   
  ActiveDocument.MailMerge.Destination = wdSendToNewDocument
  ActiveDocument.MailMerge.Execute Pause:=False
  ActiveWindow.View.ShowFieldCodes = False
End Sub
 
Function EndRange(rng As Range) As Range
  Dim myRange As Range
  Set myRange = rng
  myRange.SetRange rng.End - 1, rng.End - 1
  Set EndRange = myRange
End Function
Function StartRange(rng As Range) As Range
  Dim myRange As Range
  Set myRange = rng
  myRange.SetRange rng.Start, rng.Start
  Set StartRange = myRange
End Function
Function PartRange(rng As Range, LookFor As String) As Range
  'Stop
  Dim myRange As Range, s As Long, e As Long
  Set myRange = rng
  s = InStr(myRange, LookFor)
  e = s + Len(LookFor)
  myRange.SetRange rng.Start + s - 1, rng.Start + e - 1
  Set PartRange = myRange
End Function

Gruß Mr. K.