Listbox mit Suchanfragen-Ergebnisse mit mehr als 9 Spalten befüllen

Private Sub txtSuche_Change()
Application.ScreenUpdating = False

Dim appExcel As Excel.Application
Dim wbkExcel As Excel.Workbook
Dim wksExcel As Excel.Worksheet
Dim rngExcel As Excel.Range
Dim rngCell As Range
Dim strFirstAddress As String
Dim Suchwort As String
 
Set appExcel = Excel.Application
Set wbkExcel = Excel.Workbooks.Open("C:\VBA\Test\tbl_Quelle.xlsx", ReadOnly:=True)  
Set wksExcel = Excel.Worksheets("Quelle")  
Set rngExcel = wksExcel.UsedRange

Suchwort = ("*" & Me.txtSuche.Value & "*")  

With wksExcel.Range("C:C")  
Me.lstTreffer.Clear
Set rngExcel = .Find(Suchwort, LookIn:=xlValues, LookAt:=xlWhole)
If Not rngExcel Is Nothing Then
strFirstAddress = rngExcel.Address
Do
With Me.lstTreffer
.ColumnCount = 10
.AddItem
.List(.ListCount - 1, 1) = rngExcel.Offset(0, -1).Value
.List(.ListCount - 1, 2) = rngExcel.Offset(0, -2).Value
.List(.ListCount - 1, 3) = rngExcel.Offset(0, 3).Value
.List(.ListCount - 1, 4) = rngExcel.Offset(0, 4).Value
.List(.ListCount - 1, 5) = rngExcel.Offset(0, 5).Value
.List(.ListCount - 1, 6) = rngExcel.Offset(0, 6).Value
.List(.ListCount - 1, 7) = rngExcel.Offset(0, 7).Value
.List(.ListCount - 1, 8) = rngExcel.Offset(0, 8).Value
.List(.ListCount - 1, 9) = rngExcel.Offset(0, 9).Value
'.List(.ListCount - 1, 10) = rngExcel.Offset(0, 10).Value 'hier kommt eine Fehlermeldung  

End With
Set rngExcel = .FindNext(rngExcel)
Loop While Not rngExcel Is Nothing And rngExcel.Address <> strFirstAddress
Else
End If
End With
wbkExcel.Close
Application.ScreenUpdating = True
End Sub

Private Sub lstTreffer_Click()
Me.Spalte1 = lstTreffer.List(lstTreffer.ListCount - 1, 1)
Me.Spalte2 = lstTreffer.List(lstTreffer.ListCount - 1, 2)
'u.s.w  
End Sub