Identificar o valor de uma linha e copiá-la inteira

Bom Dia.

Sou novato em vba e preciso resolver uma questão:

Eu tenho uma planilha chamada "banco" onde tem os dados de diversas escolas
Tenho uma outra planilha chamada "pesquisa" onde o usuário pode digitar parte do nome da escola e o excel deverá retornar todos os dados da escola.

O problema é que eu sei apenas copiar o valor da célula que contém o nome da escola, as demais células com os outros dados eu não sei copiar.


Agradeço muito quem puder ajudar.



Parte das planilhas abaixo:

Planilha Pesquisar
Digite parte do nome da escola:

Nome - Endereço - Número - Diretor - Email

Planilha Banco
Escola Endereço Número Complemento Bairro Telefone 1
Doce Folia. Rua Barra do Tabagi, 121 Telefone: 3331-5530 Bom Retiro 121 Bom Retiro 3331-5530
Lápis Mágico. Rua Professor Raul Pederneiras,101 - Telefone: 2351.2767
Lua De Cristal. Rua Salvador Simões,1317 - Ipiranga - F: 5061- 4057

Aqui está o código que eu usei:

Sub BuscaParteNome()

Dim Intervalo As Range
Dim Valor As Range
Dim k As Integer
Dim nome As String

Set ws = Worksheets("Pesquisar")

LimparCelulas
Sheets("Banco").Select
Set Intervalo = [A2:F300]

For Each Valor In Intervalo

Sheets("Pesquisar").Select
nome = Range("B5").Value
k = InStr(Valor, nome)

If k > 0 Then
If ActiveCell.Value = "" Then
ActiveCell.Value = Valor
Else
Cells(ActiveCell.Row + 1, ActiveCell.Column).Select
ActiveCell.Value = Valor
End If

End If

Next Valor

End Sub

Boa tarde!!

Deposite seu arquivo em site gratuito como senspace ou outros, depois deposite o link aqui no seu post.


Att

O Sistema diz que eu não tenho permissão para links externos, portanto, vai deste modo:

tira o * do link

w*w*w.dropbox.com/sh/zf4a0dqnay8e9w9/qblwkn3BU0

Boa tarde!!

Eu ainda não tive tempo de olhar, mas tente adaptar esse código...

Código:

Sub teste()
    Dim cfind As Range, add As String, x As String
   
   
    With Worksheets("Pesquisar")
        x = .Range("B5").Value
    End With
    With Worksheets("Banco")
       
        Set cfind = .Columns("B:B").Find(what:=x, lookat:=xlPart)
        If Not cfind Is Nothing Then
            add = cfind.Address
            Range(.Cells(cfind.Row, 1), .Cells(cfind.Row, 3)).Copy
        End If
       
        With Worksheets("Pesquisar")
            .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial
        End With
        Do
           
            Set cfind = .Cells.FindNext(cfind)
            If cfind Is Nothing Then Exit Do
            If cfind.Address = add Then Exit Do
            Range(.Cells(cfind.Row, 1), .Cells(cfind.Row, 3)).Copy
           
            With Worksheets("Pesquisar")
                .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial
            End With
        Loop
    End With
    Worksheets("Pesquisar").Activate
   
    Application.CutCopyMode = False
    Application.EnableEvents = True
End Sub

Att

alexandrevba escreveu:

Boa tarde!!

Eu ainda não tive tempo de olhar, mas tente adaptar esse código...

Código:

Sub teste()
   Dim cfind As Range, add As String, x As String
   
   
   With Worksheets("Pesquisar")
       x = .Range("B5").Value
   End With
   With Worksheets("Banco")
       
       Set cfind = .Columns("B:B").Find(what:=x, lookat:=xlPart)
       If Not cfind Is Nothing Then
           add = cfind.Address
           Range(.Cells(cfind.Row, 1), .Cells(cfind.Row, 3)).Copy
       End If
       
       With Worksheets("Pesquisar")
           .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial
       End With
       Do
           
           Set cfind = .Cells.FindNext(cfind)
           If cfind Is Nothing Then Exit Do
           If cfind.Address = add Then Exit Do
           Range(.Cells(cfind.Row, 1), .Cells(cfind.Row, 3)).Copy
           
           With Worksheets("Pesquisar")
               .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial
           End With
       Loop
   End With
   Worksheets("Pesquisar").Activate
   
   Application.CutCopyMode = False
   Application.EnableEvents = True
End Sub

Att

BOM DIA.

MUITO OBRIGADO. VOU TESTAR E TENTAR ADAPTAR COMO VOCÊ MANDOU. SE NÃO CONSEGUIR, POSSO PERGUNTAR NOVAMENTE?

Bom dia!!

Citação :

MUITO OBRIGADO. VOU TESTAR E TENTAR ADAPTAR COMO VOCÊ MANDOU. SE NÃO CONSEGUIR, POSSO PERGUNTAR NOVAMENTE?

Claro!!


Att

alexandrevba escreveu:

Bom dia!!

Citação :

MUITO OBRIGADO. VOU TESTAR E TENTAR ADAPTAR COMO VOCÊ MANDOU. SE NÃO CONSEGUIR, POSSO PERGUNTAR NOVAMENTE?

Claro!!


Att

Cara, desculpa minha ignorância, mas está dando erro numa linha e eu não consigo arrumar.

Set cfind = .Cells.FindNext(cfind)

A mensagem é: Argumento ou chamada de procedimento inválida.

Valeu

Boa tarde!!

Eu não tive erro ao testar, me mande seu arquivo do jeito que está o código implementado por você!

Att