Estou utilizando esta estrutura de comando abaixo. Porém até agora não consegui descobri o comando que deixa os dados em coluna.
A informação está aparecendo em linha.

Private Sub PreencheLista()
Dim TextoDigitado As String
 TextoDigitado = Pesquisa.Text
'código que irá filtrar os nomes
 Dim linha As Integer
 'Dim coluna As Integer
 Dim TextoCelula As String
 linha = 1
 'coluna = 1
 
'limpa os dados do formulário
Lista.Clear
'Irá executar até o último nome
While ActiveSheet.Cells(linha, 1).Value <> Empty
'pega o nome atual
TextoCelula = ActiveSheet.Cells(linha, 1).Value
'TextoCelula = ActiveSheet.Cells(linha, 2).Value
'quebra a palavra atual pela esquerda conforme a quantidade de letras digitadas e compara com o texto digitado
If UCase(Left(TextoCelula, Len(TextoDigitado))) = UCase(TextoDigitado) Then
'se a comparação for igual será adicionado no formulario

Lista.AddItem ActiveSheet.Cells(linha, 1)
Lista.AddItem ActiveSheet.Cells(linha, 1 + 1)
Lista.AddItem ActiveSheet.Cells(linha, 1 + 2)
Lista.AddItem ActiveSheet.Cells(linha, 1 + 3)
Lista.AddItem ActiveSheet.Cells(linha, 1 + 4)
Lista.AddItem ActiveSheet.Cells(linha, 1 + 5)
 End If
 linha = linha + 1
 'coluna = coluna + 1
 Wend

End Sub

Precisamos definir a qde de Colunas antes e depois criar uma Variável para incrementar o LIST, a Propriedade AddItem será sempre linhas.

Troque pela rotina abaixo, nela está definido 03 Colunas, ajuste conforme sua necessidade :

'Qde de Colunas
.ColumnCount = 3

'Aqui pegamos os dados da coluna 3 da planilha
Lista.List(i, 2) = ActiveSheet.Cells(linha, 1 + 2)

Private Sub PreencheLista()
    Dim TextoDigitado As String
    TextoDigitado = Pesquisa.Text
    'código que irá filtrar os nomes
    Dim linha As Integer
    'Dim coluna As Integer
    Dim TextoCelula As String
    Dim i
    
    linha = 2
    'coluna = 1
 
    'limpa os dados do formulário
    Lista.Clear

    i = 0
    
    'Definimos a qde de colunas e largura
    With Me.Lista
        'Qde de Colunas
        .ColumnCount = 3
        
        'Largura das Colunas
        '.ColumnWidths = "2 cm;2 cm;2 cm"
        
    End With

    'Irá executar até o último nome
    While ActiveSheet.Cells(linha, 1).Value <> Empty
        
        'pega o nome atual
        TextoCelula = ActiveSheet.Cells(linha, 1).Value
            
            'quebra a palavra atual pela esquerda conforme a quantidade de letras digitadas e compara com o texto digitado
            If UCase(Left(TextoCelula, Len(TextoDigitado))) = UCase(TextoDigitado) Then
                'se a comparação for igual será adicionado no formulario
                
                Lista.AddItem ActiveSheet.Cells(linha, 1)
                Lista.List(i, 1) = ActiveSheet.Cells(linha, 1 + 1)
                Lista.List(i, 2) = ActiveSheet.Cells(linha, 1 + 2)
                
                i = i + 1
             
            End If
     
        linha = linha + 1
        'coluna = coluna + 1
     Wend

End Sub

[]s