Listbox mit mehr als 10 Spalten

Hallo zusammen,
ich hab mal wieder eine Frage.
Ich fülle mit diesem Makro eine Listbox und musste jetzt feststellen das nach 10 Spalten leider Schluss ist.
Ich bräuchte aber mindestens 25 Spalten. Ist diese möglich und wenn ja wie.

Private Sub ComboBox1_Change()
Dim lz As Long
Dim rngcell As Range
Dim strFirstAddress As String
lz = Sheets("Daten").Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("Daten").Range("P1:P" & lz)
Me.ListBox1.Clear
Set rngcell = .Find(StartUF.ComboBox1.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not rngcell Is Nothing Then
strFirstAddress = rngcell.Address
Do
If rngcell.Offset(0, 32).Value = ÜbersichtUF.ComboBox1.Value Then
If rngcell.Offset(0, 32).Value = "40" Then
With Me.ListBox1
.ColumnCount = 10
.AddItem
.List(.ListCount - 1, 0) = rngcell.Offset(0, -15).Value
.List(.ListCount - 1, 1) = rngcell.Offset(0, 1).Value
.List(.ListCount - 1, 2) = rngcell.Offset(0, 36).Value
.List(.ListCount - 1, 3) = rngcell.Offset(0, 37).Value
.List(.ListCount - 1, 4) = rngcell.Offset(0, 38).Value
.List(.ListCount - 1, 5) = rngcell.Offset(0, 39).Value
.List(.ListCount - 1, 6) = rngcell.Offset(0, 40).Value
.List(.ListCount - 1, 7) = rngcell.Offset(0, 41).Value
.List(.ListCount - 1, 8) = rngcell.Offset(0, 42).Value
.ColumnWidths = "2cm;1cm;1cm;1cm;1cm;1cm;1cm;1cm;1cm;1cm"
End With
End If
Set rngcell = .FindNext(rngcell)
Loop While Not rngcell Is Nothing And rngcell.Address <> strFirstAddress
End If
End With
End Sub