Fórum Excel Bácico, Avançado e Vba

Este fórum é destina a usuário de Excel, que queiram compartilhar informações a básicas, avançadas e programação em VBA...
 
InícioInício  FAQFAQ  BuscarBuscar  MembrosMembros  GruposGrupos  Registrar-seRegistrar-se  Login  

Compartilhe | 
 

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

Ver o tópico anterior Ver o tópico seguinte Ir em baixo 
AutorMensagem
leandrobaldocchi



Mensagens : 4
Data de inscrição : 18/03/2014

MensagemAssunto: Identificar o valor de uma linha e copiá-la inteira   Ter Mar 18, 2014 4:43 pm

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
Voltar ao Topo Ir em baixo
Ver perfil do usuário
alexandrevba



Mensagens : 1820
Data de inscrição : 13/07/2011
Localização : Serra - ES

MensagemAssunto: Re: Identificar o valor de uma linha e copiá-la inteira   Ter Mar 18, 2014 7:14 pm

Boa tarde!!

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


Att
Voltar ao Topo Ir em baixo
Ver perfil do usuário
leandrobaldocchi



Mensagens : 4
Data de inscrição : 18/03/2014

MensagemAssunto: Re: Identificar o valor de uma linha e copiá-la inteira   Ter Mar 18, 2014 7:33 pm

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
Voltar ao Topo Ir em baixo
Ver perfil do usuário
alexandrevba



Mensagens : 1820
Data de inscrição : 13/07/2011
Localização : Serra - ES

MensagemAssunto: Re: Identificar o valor de uma linha e copiá-la inteira   Ter Mar 18, 2014 9:26 pm

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
Voltar ao Topo Ir em baixo
Ver perfil do usuário
leandrobaldocchi



Mensagens : 4
Data de inscrição : 18/03/2014

MensagemAssunto: Re: Identificar o valor de uma linha e copiá-la inteira   Qua Mar 19, 2014 12:59 pm

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?
Voltar ao Topo Ir em baixo
Ver perfil do usuário
alexandrevba



Mensagens : 1820
Data de inscrição : 13/07/2011
Localização : Serra - ES

MensagemAssunto: Re: Identificar o valor de uma linha e copiá-la inteira   Qua Mar 19, 2014 2:29 pm

Bom dia!!

Citação :
MUITO OBRIGADO. VOU TESTAR E TENTAR ADAPTAR COMO VOCÊ MANDOU. SE NÃO CONSEGUIR, POSSO PERGUNTAR NOVAMENTE?
Claro!!


Att
Voltar ao Topo Ir em baixo
Ver perfil do usuário
leandrobaldocchi



Mensagens : 4
Data de inscrição : 18/03/2014

MensagemAssunto: Re: Identificar o valor de uma linha e copiá-la inteira   Qua Mar 19, 2014 6:42 pm

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
Voltar ao Topo Ir em baixo
Ver perfil do usuário
alexandrevba



Mensagens : 1820
Data de inscrição : 13/07/2011
Localização : Serra - ES

MensagemAssunto: Re: Identificar o valor de uma linha e copiá-la inteira   Qua Mar 19, 2014 9:56 pm

Boa tarde!!

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

Att
Voltar ao Topo Ir em baixo
Ver perfil do usuário
Conteúdo patrocinado




MensagemAssunto: Re: Identificar o valor de uma linha e copiá-la inteira   Hoje à(s) 2:53 am

Voltar ao Topo Ir em baixo
 
Identificar o valor de uma linha e copiá-la inteira
Ver o tópico anterior Ver o tópico seguinte Voltar ao Topo 
Página 1 de 1
 Tópicos similares
-
» widgets para toda linha wave. Espero que cutão :D
» [TUTORIAL] Flashplayer 11.0.1.152 em toda linha Wave !
» Atras da linha vermelha
» [RESOLVIDO]Valor de step
» [Resolvido] Menu com linha é possivel?

Permissão deste fórum:Você não pode responder aos tópicos neste fórum
Fórum Excel Bácico, Avançado e Vba :: Intermediário :: Excel Intermediário-
Ir para: