Só fiz uma mudança ai no código onde é vermelho...

Private Sub PreencheLista(ByVal TextoDigitado As String)
    Dim ws As Worksheet
    Dim i As Integer
    Dim x As Integer
    Dim indiceLista As Integer
    Dim coluna As Integer
    Dim TextoCelula As String
    Set ws = ThisWorkbook.Worksheets(NomePlanilha)
    Dim Lista()

    ReDim Lista(ws.UsedRange.Columns.Count, 0)

    i = 2
    indiceLista = 0
    coluna = Me.ComboBoxCampos.ListIndex + 1
    'Call PreencheCabecalho(Lista)

    ListBoxLista.Clear
    With ws
        While .Cells(i, coluna).Value <> Empty
            TextoCelula = .Cells(i, coluna).Value
            If UCase(Left(TextoCelula, Len(TextoDigitado))) = UCase(TextoDigitado) Then

                For x = 0 To ws.UsedRange.Columns.Count - 1
                 ReDim Preserve Lista(ws.UsedRange.Columns.Count, indiceLista)
             [color=#FF0000]   If x = 4 Then
                
                    Lista(x, indiceLista) = Format(.Cells(i, x + 1), "R$ #,##0.00")
                Else
               
                    Lista(x, indiceLista) = .Cells(i, x + 1)
                End If[/color]
                
                 
                Next

                indiceLista = indiceLista + 1
            End If
            i = i + 1
        Wend
    End With
   
    Lista = Array2DTranspose(Lista)

    Me.ListBoxLista.List = Lista
End Sub

Show de bola, deu certo!! Muito obrigado...