Fábio!

Eu realizei o teste com o seu arquivo e ele exibiu as colunas normalmente, mas eu percebi que cometi um pequeno deslize, que pode ser o que está deletando colunas indesejadas no seu arquivo.
Quando a linha que deletava colunas era acionada, eu não especificava qual Aba deveria estar selecionada (ou seja, se você estivesse com a aba Dados, Motivos, Responsavel ou Lista selecionada, ele deletaria as colunas do mesmo jeito, sendo que o desejado é que apenas a lista seja modificada). Quando você informava um número de registro e nome que não existia, ele mantinha a aba Dados selecionada e mesmo assim deletava colunas... acredito que seja este o seu caso.

De qualquer forma, eu modifiquei a forma de deletar colunas, para garantir que não haja erro por motivo de exclusão de colunas na aba errada. Observe que no novo arquivo, eu criei a função deleta_Cols() (que é chamada através da função listar(), que antes não verificava dinamicamente) para deletar colunas de uma aba específica (lista) com nomes específicos (Sufixo, Referência, Tipo De Pedido, Valor, Estoque). Observe que adicionando ou removendo linhas no condicional If, é possível adicionar ou remover colunas a serem deletadas.

Aproveitei também para modificar a lista.UserForm_Initialize() para usar a propriedade UsedRange.Address (que pega todas as linhas e colunas preenchidas em uma aba, evitando assim que fiquem para trás linhas ou colunas da lista)

Abraços e à disposição para ajudá-lo,

Murilo.

Murilo.
Muito obrigado pela ajuda e paciência.

Desculpe a pergunta mais você testou o arquivo ?
Não sei que esta acontecendo pois quando realizo a pesquisa para mim aparece desta forma.

Será que existe algum problema com meu excel?

Abraços

Fabiosp

Sim eu testei o arquivo e ele aparece normalmente pra mim rsrsrs... mas o que eu achei estranho é o fato de suas colunas estarem totalmente desalinhadas, pois mesmo que eu esteja colocando manualmente a largura delas não era para estar assim.

Por favor, vamos realizar mais um teste: Eu comentei no método lista.UserForm_Initialize() a linha que contém a propriedade .ColumnWidths (utilizada para definir a largura das colunas). Minha intenção é de manter o tamanho padrão para que possamos verificar de que forma será exibido no seu computador e identificar se essa propriedade pode estar reduzindo alguma coluna a ponto de que não fique visível.
Disponibilizei mais um anexo com essa modificação, para agilizar um pouco o trabalho.

As print screens abaixo foram tiradas do próprio arquivo que você enviou, e a pesquisa é listada normalmente.

Abaixo, uma print screen de como a aba lista fica para mim:

Murilo

Muito obrigado pela ajuda caro colega.
Efetuei os testes e agora funcionou.
Acho que estava ocultando alguma coluna ou coisa desse tipo.
Esse código que contem os tamanhos das colunas eu posso alterar quando for necessário?
Acho que agora esta tudo certo!!
Poxa, você não sabe como foi útil sua ajuda.
Mais uma vez muito obrigado.

 Private Sub cmd_Pesquisar_Click()
Dim bool As Boolean 'Variável utilizada na Function 'listar' para comparar o retorno da função

    Call listar(txt_NoRegistro.Text, txt_Cliente.Text, bool)
    
    If bool = True Then 'Se ao menos um registro foi encontrado na pesquisa da Function:
        Unload Me
        lista.Show
        Else:
    End If
End Sub

Private Sub cmd_Voltar_Click()
    Unload Me
    pesquisar.Show
End Sub

Private Sub UserForm_Initialize()
    Sheets("lista").Select

    With ListPesquisa
        .ColumnCount = 10 'Número de Colunas na ListBox
        .RowSource = ActiveSheet.UsedRange.Address 'Fonte de Dados será o intervalo que contém células preenchidas
        'Abaixo, defino manualmente o tamanho de cada coluna do ListBox:
        '.ColumnWidths = "1,8 cm; 3,1 cm; 2,5 cm; 3,1 cm; 2cm; 2cm; 3cm"
    End With

    Sheets("Dados").Select
End Sub




Private Sub cmd_Fechar_Click()
    Unload Me
End Sub

Private Sub cmd_Gravar_Click()
Dim iLastRow As Integer

    iLastRow = ActiveSheet.UsedRange.Rows.Count 'Conta o número de linhas preenchidas no arquivo
    
    iLastRow = iLastRow + 1 'valor de iLastRow será a próxima célula (que estará vazia)

'Preencher as células vazias com os valores das TextBoxes:
'-----------
    Range("A" & iLastRow).Value = txt_NoRegistro.Text
    Range("C" & iLastRow).Value = txt_Cliente.Text
    Range("D" & iLastRow).Value = txt_Dia.Text
    Range("H" & iLastRow).Value = txt_Responsavel.Text
    Range("I" & iLastRow).Value = txt_Control1.Text
    Range("J" & iLastRow).Value = txt_Control2.Text
    Range("M" & iLastRow).Value = cboMotivo1.Text
    Range("N" & iLastRow).Value = cboMotivo2.Text
    Range("O" & iLastRow).Value = cboMotivo3.Text
    Range("L" & iLastRow).Value = txt_Nascimento.Text
'-----------

    ActiveWorkbook.Save 'Salva a pasta de trabalho
End Sub

Private Sub cmd_Limpar_Click()
    For Each ctl In Me.Controls 'Para cada objeto de controle
        If TypeName(ctl) = "TextBox" Or _
           TypeName(ctl) = "ComboBox" Then   'Se o tipo for TextBox OU ComboBox (combo de Motivos)
        ctl.Text = vbNullString 'Limpa o conteúdo
        
        End If
    Next ctl 'Próximo objeto de controle
    
    txt_Dia.Text = Format(Now, "dd/mm/yyyy") 'Redefine o dia
End Sub

Private Sub cmd_Pesquisar_Click()
Dim bool As Boolean 'Variável utilizada na Function 'listar' para comparar o retorno da função

    Call listar(txt_NoRegistro.Text, txt_Cliente.Text, bool)
    
    If bool = True Then 'Se ao menos um registro foi encontrado na pesquisa da Function:
        Unload Me
        lista.Show
        Else:
    End If
    
End Sub

Private Sub UserForm_Click()

'Cria as tags para cada campo (a tag será o valor da coluna na linha 1)
'-----------
    txt_Cliente.Tag = "Nome Do Cliente"
    txt_NoRegistro.Tag = "No Registro"
    txt_Dia.Tag = "Dia Do Registro"
    txt_Responsavel.Tag = "Nome Do Responsável"
    txt_Control1.Tag = "Controle 1"
    txt_Control2.Tag = "Controle 2"
    cboMotivo1.Tag = "Motivo 1"
    cboMotivo2.Tag = "Motivo 2"
    cboMotivo3.Tag = "Motivo 3"
    txt_Nascimento.Tag = "Data De Nascimento"
'-----------


End Sub

Private Sub UserForm_Activate()
    txt_Dia.Text = Format(Now, "dd/mm/yyyy")
End Sub


Function listar(no_reg As String, nome_cli As String, bool) As Boolean

Dim celula As Range
Dim achou As Boolean 'Será utilizado para verificar se a macro possuirá ao menos 1 registro na lista

Application.ScreenUpdating = False

bool = False 'Atualiza o valor de bool para falso

Sheets("Lista").Rows.Clear 'Limpa a Lista que contém os dados da Pesquisa
    Sheets("Dados").Rows("1:1").Copy Sheets("Lista").Rows("1:1") 'Copia o cabeçalho (linha 1) da sheet Dados

    If no_reg = "" And nome_cli = "" Then
        MsgBox "O cliente e/ou nº de registro não foi informado", vbInformation
        Exit Function 'Sai da macro, caso as textbox estejam vazias (não é possível realizar o filtro)
    Else:
    
    achou = False 'Valor da booleana será falso

    iLastRow = Sheets("Dados").UsedRange.Rows.Count 'Conta o número de linhas preenchidas no arquivo

    For Each celula In Sheets("Dados").Range("A2:A" & iLastRow)
        If celula.Value = no_reg Or celula.Offset(0, 2).Value = nome_cli Then 'Compara o valor do textbox com as celulas
            achou = True 'Achou ao menos um registro para a lista
            With Sheets("Lista")
                .Activate 'Seleciona a sheet Lista
                celula.EntireRow.Copy .Rows(.UsedRange.Rows.Count + 1) 'Copia a célula atual do laço para a próxima celula em branco da lista
            End With
        End If
    Next
    
     Call deleta_Cols 'Chama a Sub que deleta colunas indesejadas da lista
    
    If achou = False Then 'Se não foram encontrados nenhum registro com o nº de registro e cliente informados:
        MsgBox "Não foram encontrados nenhum registro com o cliente '" & pesquisar.txt_Cliente.Text & _
               "' ou nº de registro '" & pesquisar.txt_NoRegistro.Text & "'"
        bool = False 'False (não continuará a macro de pesquisa, pois não foram encontrados resultados)
        Sheets("Dados").Select
        Exit Function 'Sai da Macro
    
    Else:           'Caso a sheet Lista possua ao menos um registro:
        'Unload Me   'Fecha o Form
        bool = True 'Continuará a pesquisa
        
    End If

End If

Application.ScreenUpdating = False

End Function


Sub deleta_Cols()

Dim i, iLastCol As Long

    With Sheets("Lista")
        .Select

        iLastCol = ActiveSheet.UsedRange.Columns.Count 'Conta o número de colunas preenchidas na lista
        
        For i = 1 To iLastCol
            If .Cells(1, i).Value = "Sufixo" Or _
               .Cells(1, i).Value = "Referência" Or _
               .Cells(1, i).Value = "Tipo De Pedido" Or _
               .Cells(1, i).Value = "Valor" Or _
               .Cells(1, i).Value = "Estoque" Then
                    .Cells(1, i).EntireColumn.Delete 'Deleta a coluna inteira
                    i = 0 'Procura novamente as colunas desde o início
            End If
        Next i
    End With

End Sub
 

Nunca tive problemas com ColumnWidths nos arquivos que criei anteriormente, essa foi a primeira vez que houve diferença entre um computador e outro rsrsrs

Você pode realizar testes na sua máquina, alterando o tamanho das colunas e executando o UserForm para ver como ficou (se há a necessidade de aumentar / diminuir) até que as colunas estejam adequadas para visualização.
Eu desconheço alguma função automática e padrão do VBA que permita definir a largura das colunas automaticamente, e acredito que essa opção realmente não existe para ListBoxes. Talvez fuçando pela net vc encontre uma função de usuário que possa trabalhar dessa forma, caso seja de seu interesse.

Caso não haja mais necessidade de modificar o arquivo, por favor marque o tópico como [Resolvido] para podermos encerrar este caso

Abraços e à disposição para quaisquer dúvidas,

Murilo.

Grande mestre Murilo

Efetuei os testes esta conforme imaginei muito obrigado!!
Agora só mais uma pergunta juro que será a última. rs rs rs
Percebi que se eu efetuar a pesquisa apenas digitando o número do registro retorna resultado caso houver, porém se digitar só o nome do cliente não e feito a pesquisa sai aquela mensagem falando que não existe nome ou numero digitado.
Será que e mais um problema com minha máquina?
Muito obrigado pela ajuda!

Abraços.
Fabiosp

Você pesquisou pelo nome exato ou por um texto que faz parte do respectivo nome?
Por exemplo: Se você procura por prof murilo, fabiosp ou fabao, ele traz todos os clientes que estejam com esse exato nome... mas se vc procura somente por prof, murilo ou fabio ele não trará resultados e aparece a mensagem falando que não existe o registro, visto que a macro procura por valores exatos nas células.

Se vc digitou no campo Nome do cliente por completo, sem alta caixa nos caracteres ou espaços desnecessários, a macro deverá trazer o resultado...

Por favor, verifique o novo arquivo em anexo, onde consta uma nova função chamada InStr na função listar, que procura caracteres específicos dentro de um texto (que no nosso caso, é o texto das células com nomes de cliente).
Nesse caso, se vc pesquisar por fab, ele trará tanto fabiosp como fabao, visto que agora procura no conteúdo do texto intervalos de caracteres... segue abaixo o trecho modificado:

If celula.Value = no_reg Or InStr(1, celula.Offset(0, 2).Value, nome_cli) > 0 Then  'Compara o valor do textbox com as celulas

Murilo

Testei o novo arquivo e com o ajuste que você efetuou agora esta perfeito show de bola mestre.rs rs rs

No arquivo anterior estava digitando o nome com letra minúscula e não estava pesquisando mas agora percebi que se por exemplo o nome estiver registrado como Ze da padoca se o Z não estiver maiúsculo a pesquisa não é efetuada.

Resumindo para pesquisar o nome deverá estar idêntico ao registrado na plan Dados.

Referente ao tamanho das colunas acho que descobri que era o problema.

Troquei ; por , conforme o código abaixo e funcionou.

Acho que o motivo do erro era que meu OS original estava em inglês e depois eu puxei um language pack para o português.

Private Sub cmd_Pesquisar_Click()
Dim bool As Boolean 'Variável utilizada na Function 'listar' para comparar o retorno da função

    Call listar(txt_NoRegistro.Text, txt_Cliente.Text, bool)
    
    If bool = True Then 'Se ao menos um registro foi encontrado na pesquisa da Function:
        Unload Me
        lista.Show
        Else:
    End If
End Sub

Private Sub cmd_Voltar_Click()
    Unload Me
    pesquisar.Show
End Sub

Private Sub UserForm_Initialize()
    Sheets("lista").Select

    With ListPesquisa
        .ColumnCount = 10 'Número de Colunas na ListBox
        .RowSource = ActiveSheet.UsedRange.Address 'Fonte de Dados será o intervalo que contém células preenchidas
        'Abaixo, defino manualmente o tamanho de cada coluna do ListBox:
        .ColumnWidths = "1,8 cm,3,1 cm,2,5 cm,3,1 cm,2cm,2cm,3cm"
    End With

    Sheets("Dados").Select
End Sub



Private Sub cmd_Fechar_Click()
    Unload Me
End Sub

Private Sub cmd_Gravar_Click()
Dim iLastRow As Integer

    iLastRow = ActiveSheet.UsedRange.Rows.Count 'Conta o número de linhas preenchidas no arquivo
    
    iLastRow = iLastRow + 1 'valor de iLastRow será a próxima célula (que estará vazia)

'Preencher as células vazias com os valores das TextBoxes:
'-----------
    Range("A" & iLastRow).Value = txt_NoRegistro.Text
    Range("C" & iLastRow).Value = txt_Cliente.Text
    Range("D" & iLastRow).Value = txt_Dia.Text
    Range("H" & iLastRow).Value = txt_Responsavel.Text
    Range("I" & iLastRow).Value = txt_Control1.Text
    Range("J" & iLastRow).Value = txt_Control2.Text
    Range("M" & iLastRow).Value = cboMotivo1.Text
    Range("N" & iLastRow).Value = cboMotivo2.Text
    Range("O" & iLastRow).Value = cboMotivo3.Text
    Range("L" & iLastRow).Value = txt_Nascimento.Text
'-----------

    ActiveWorkbook.Save 'Salva a pasta de trabalho
End Sub

Private Sub cmd_Limpar_Click()
    For Each ctl In Me.Controls 'Para cada objeto de controle
        If TypeName(ctl) = "TextBox" Or _
           TypeName(ctl) = "ComboBox" Then   'Se o tipo for TextBox OU ComboBox (combo de Motivos)
        ctl.Text = vbNullString 'Limpa o conteúdo
        
        End If
    Next ctl 'Próximo objeto de controle
    
    txt_Dia.Text = Format(Now, "dd/mm/yyyy") 'Redefine o dia
End Sub

Private Sub cmd_Pesquisar_Click()
Dim bool As Boolean 'Variável utilizada na Function 'listar' para comparar o retorno da função

    Call listar(txt_NoRegistro.Text, txt_Cliente.Text, bool)
    
    If bool = True Then 'Se ao menos um registro foi encontrado na pesquisa da Function:
        Unload Me
        lista.Show
        Else:
    End If
    
End Sub

Private Sub UserForm_Click()

'Cria as tags para cada campo (a tag será o valor da coluna na linha 1)
'-----------
    txt_Cliente.Tag = "Nome Do Cliente"
    txt_NoRegistro.Tag = "No Registro"
    txt_Dia.Tag = "Dia Do Registro"
    txt_Responsavel.Tag = "Nome Do Responsável"
    txt_Control1.Tag = "Controle 1"
    txt_Control2.Tag = "Controle 2"
    cboMotivo1.Tag = "Motivo 1"
    cboMotivo2.Tag = "Motivo 2"
    cboMotivo3.Tag = "Motivo 3"
    txt_Nascimento.Tag = "Data De Nascimento"
'-----------


End Sub

Private Sub UserForm_Activate()
    txt_Dia.Text = Format(Now, "dd/mm/yyyy")
End Sub


Function listar(no_reg As String, nome_cli As String, bool) As Boolean

Dim celula As Range
Dim achou As Boolean 'Será utilizado para verificar se a macro possuirá ao menos 1 registro na lista

Application.ScreenUpdating = False

bool = False 'Atualiza o valor de bool para falso

Sheets("Lista").Rows.Clear 'Limpa a Lista que contém os dados da Pesquisa
    Sheets("Dados").Rows("1:1").Copy Sheets("Lista").Rows("1:1") 'Copia o cabeçalho (linha 1) da sheet Dados

    If no_reg = "" And nome_cli = "" Then
        MsgBox "O cliente e/ou nº de registro não foi informado", vbInformation
        Exit Function 'Sai da macro, caso as textbox estejam vazias (não é possível realizar o filtro)
    Else:
    
    achou = False 'Valor da booleana será falso

    iLastRow = Sheets("Dados").UsedRange.Rows.Count 'Conta o número de linhas preenchidas no arquivo

    For Each celula In Sheets("Dados").Range("A2:A" & iLastRow)
        If celula.Value = no_reg Or InStr(1, celula.Offset(0, 2).Value, nome_cli) > 0 Then  'Compara o valor do textbox com as celulas
            achou = True 'Achou ao menos um registro para a lista
            With Sheets("Lista")
                .Activate 'Seleciona a sheet Lista
                celula.EntireRow.Copy .Rows(.UsedRange.Rows.Count + 1) 'Copia a célula atual do laço para a próxima celula em branco da lista
            End With
        End If
    Next
    
     Call deleta_Cols 'Chama a Sub que deleta colunas indesejadas da lista
    
    If achou = False Then 'Se não foram encontrados nenhum registro com o nº de registro e cliente informados:
        MsgBox "Não foram encontrados nenhum registro com o cliente '" & pesquisar.txt_Cliente.Text & _
               "' ou nº de registro '" & pesquisar.txt_NoRegistro.Text & "'"
        bool = False 'False (não continuará a macro de pesquisa, pois não foram encontrados resultados)
        Sheets("Dados").Select
        Exit Function 'Sai da Macro
    
    Else:           'Caso a sheet Lista possua ao menos um registro:
        'Unload Me   'Fecha o Form
        bool = True 'Continuará a pesquisa
        
    End If

End If

Application.ScreenUpdating = False

End Function


Sub deleta_Cols()

Dim i, iLastCol As Long

    With Sheets("Lista")
        .Select

        iLastCol = ActiveSheet.UsedRange.Columns.Count 'Conta o número de colunas preenchidas na lista
        
        For i = 1 To iLastCol
            If .Cells(1, i).Value = "Sufixo" Or _
               .Cells(1, i).Value = "Referência" Or _
               .Cells(1, i).Value = "Tipo De Pedido" Or _
               .Cells(1, i).Value = "Valor" Or _
               .Cells(1, i).Value = "Estoque" Then
                    .Cells(1, i).EntireColumn.Delete 'Deleta a coluna inteira
                    i = 0 'Procura novamente as colunas desde o início
            End If
        Next i
    End With

End Sub

Finalmente depois de sua generosa ajuda poderei trabalhar usando esse novo formulário.

Muito obrigado mestre Murilo e até a próxima. rs rs rs

Abraços

Fabiosp

Nossa bem lembrado, o Excel em inglês usa vírgulas, e o pack não considera isso.. que m**** kkk

Fico à disposição para ajudar quando necessário.

Murilo

Bom Murilo

Valeu pela ajuda.
A planilha esta funcionado perfeitamente.
O lance da , e ; descobri sem querer querendo. rsrsrs
Com certeza irei precisar e ajuda em um futuro próximo rsrsrs
Por enquanto mais um vez obrigado!

Abraços

Fabiosp