Retornar o resultado de uma busca abaixo da activecell

[rdvision]

Após varias buscar pela web entre foros e previas  dos books google, venho incomodar.
Tento adaptar um código  em que realiza um  basca em  plan1 de  uma  activecell da plan2, e que o resultado da busca retorne abaixo da  activecell da plan2, so estou obtendo sucesso quando especifico a Range("B" & Contador), espero ter sido claro, segue o código abaixo:

Sub teste3()
Dim PrimeiraOcorrencia As String
   Dim mVetor As Variant
   Dim Intervalo As Range
   Dim Contador As Long
   Dim I As Long
   Dim NovaPlanilha As Worksheet
   With Application
       .ScreenUpdating = False
       .EnableEvents = False
   End With
   'Define o critério de buca em um array
    mVetor = Array(ActiveCell)
   'transporta para a variavel mvetor o valor da celula ativa
   Set NovaPlanilha = Sheets("Plan2")
   With Sheets("Plan1").Range("A1:C110000")
       Contador = 0
       For I = LBound(mVetor) To UBound(mVetor)

           Set Intervalo = .Find(What:=mVetor(I), _
                                 After:=.Cells(.Cells.Count), _
                                 LookIn:=xlFormulas, _
                                 LookAt:=xlPart, _
                                 SearchOrder:=xlByRows, _
                                 SearchDirection:=xlNext, _
                                 MatchCase:=False)
           If Not Intervalo Is Nothing Then
               PrimeiraOcorrencia = Intervalo.Address
               Do
                   Contador = Contador + 1
                    Intervalo.Offset(0, 2).Copy NovaPlanilha.Range("a" & Contador)
                    Intervalo.Offset(0, 3).Copy NovaPlanilha.Range("B" & Contador)
                                         'até aqui tudo bem, mas se eu quiser o resultado abaixo da activecell;  ou melhor ainda seria, uma offset da célula ativa. Ai não consigo.
                    'linha abaixo da erro
:
                   Intervalo.Offset(0, 2).Copy NovaPlanilha.Range(ActiveCell & Contador)
                   Set Intervalo = .FindNext(Intervalo)
               Loop While Not Intervalo Is Nothing And Intervalo.Address <> PrimeiraOcorrencia
           End If
       Next I
   End With
   With Application
       .ScreenUpdating = True
      .EnableEvents = True
   End With
End Sub

Desde já agradeço, bem como também a dica de um bom livro de vba excel  pra alguém que não saca de inglês.

[Mauro Coutinho]

rdvision, o ideal seria anexar um modelo reduzido e compactado para ilustrar melhor o que pretende facilitando a compreensão da aplicação de sua rotina.
Eu não compreendi porque está utilizando ARRAY referenciando a uma única Celula ou seja a Celula Ativa (ActiveCell), e como temos somente um o Loop tambem não funcionará

mVetor = Array(ActiveCell) - Temos somente um valor dentro do Array
For I = LBound(mVetor) To UBound(mVetor) - então o For será sempre 1 e não efetuará o Loop.

Mas como disse que está ok e o problema é jogar o valor para a linha de baixo respeitando a Coluna, altere a linha:
Intervalo.Offset(0, 2).Copy NovaPlanilha.Range(ActiveCell & Contador) para :
Intervalo.Offset(0, 2).Copy NovaPlanilha.Range(ActiveCell & Contador + 1) - somamos mais 1 ao contador que se refere a Linha.

Faça a alteração teste e veja se é isto.

[]s

[rdvision]

rdvision, o ideal seria anexar um modelo reduzido e compactado para ilustrar melhor o que pretende facilitando a compreensão da aplicação de sua rotina.
Eu não compreendi porque está utilizando ARRAY referenciando a uma única Celula ou seja a Celula Ativa (ActiveCell), e como temos somente um o Loop tambem não funcionará

mVetor = Array(ActiveCell) - Temos somente um valor dentro do Array
For I = LBound(mVetor) To UBound(mVetor) - então o For será sempre 1 e não efetuará o Loop.

Mas como disse que está ok e o problema é jogar o valor para a linha de baixo respeitando a Coluna, altere a linha:
Intervalo.Offset(0, 2).Copy NovaPlanilha.Range(ActiveCell & Contador) para :
Intervalo.Offset(0, 2).Copy NovaPlanilha.Range(ActiveCell & Contador + 1) - somamos mais 1 ao contador que se refere a Linha.

Faça a alteração teste e veja se é isto.

[]s

Obrigado pela rápida resposta, e vi que é um dos membros mais ativos do fórum, sua ajuda neste post vale muito pra mim, e super feliz por não apenas tentar solucionar o problema, mas pela forma que o faz, fazendo com que compreendamos o código, fez-me lembra do ditado em que não se da o peixe, mas ensinasse a pescar! Ou seja, não ter apenas a solução, mas também a compreensão vale ouro.
Voltando ao poste:
Compreendo o que diz pelo array ser um vetor (referir-se a varias células) bem como quando se fala de uma range
Porem sem o Array(“xx”) o código não funciona, mesmo não sendo o argumento correto a ser usado: mVetor = Array(ActiveCell), esta funcionando, rs..
Testei a linha:
Intervalo.Offset(0, 2).Copy NovaPlanilha.Range(ActiveCell & Contador + 1)
Mas não obtive êxito
Somente quando especifico uma coluna o código funciona. Ex:
ntervalo.Offset(0, 2).Copy NovaPlanilha.Range("a" & Contador)
mas neste caso o resultado aparece apartir da célula A1,
onde em “a” queria que fosse abaixo da célula ativa que gerou a busca
testei esta linha também:
Intervalo.Offset(0, 2).Copy Selection.Offset(1, 0)
Porem retorna apenas o ultimo resultado da busca abaixo da seleção , tentei usar o & contador para retornar o restante da busca, mas sem sucesso
Mas uma vez, obrigado.

[Mauro Coutinho]

rdvision, como disse no inicio o ideal é anexar seu modelo, somente pelas instruções eu posso interpretar as ações, e como ainda tem esta questão do Array que não compreendi fica dificil dar uma resposta positiva.
Pelo fato de estar trabalhando com ActiveCell, temos te ter consciência de que estamos trabalhando com a celula ativa no momento da execução da rotina, então o ideal é ver o modelo para poder interpretar melhor o que pretende.
De uma olhada no link abaixo fala sobre a propriedade Offset, como é o funcionamento da mesma, talvez ajude, se não, anexe um modelo.

Range, Cells e Offset
http://excelevba.com.br/range-cells-e-offset/

[]s

[rdvision]

rdvision, como disse no inicio o ideal é anexar seu modelo, somente pelas instruções eu posso interpretar as ações, e como ainda tem esta questão do Array que não compreendi fica dificil dar uma resposta positiva.
Pelo fato de estar trabalhando com ActiveCell, temos te ter consciência de que estamos trabalhando com a celula ativa no momento da execução da rotina, então o ideal é ver o modelo para poder interpretar melhor o que pretende.
De uma olhada no link abaixo fala sobre a propriedade Offset, como é o funcionamento da mesma, talvez ajude, se não, anexe um modelo.

Range, Cells e Offset
http://excelevba.com.br/range-cells-e-offset/

[]s

Em anexo arquivo exemplo com o código
Ao abrir o arquivo já estará em uma célula selecionada a qual quero realizar a busca, ao executar o macro o resultado aparece no topo da planilha, onde gostaria que aparecesse abaixo da célula selecionada que gerou a pesquisa.
Atenciosamente

[Mauro Coutinho]

rdvision, como eu disse com o modelo fica mais fácil entender.
Mas antes de utilizar o código você precisa estar atendo ao que eu disse anteriormente referente a questão de estarmos utilizando "ActiveCell", em seu modelo o nº 31 já está inserido em "A24", então para que a rotina funcione antes de roda-la esta Celula tem de estar selecionada, não sei como você fará a chamada a rotina mas tenha isto em mente, o ideal seria utilizarmos no Evento Change da planilha, ou seja sempre que a aba sofrer alguma alteração a macro é chamada e logicamente se for desta maneira devemos ajustar a rotina para captar qual celula estamos alterando e orientar na rotina se deve seguir ou não.

Voltando a sua rotina, segue com a adaptação para funcionar da forma que eu citei, a celula tem de estar selecionada antes:

Código: Selecionar todos

Sub teste()
Dim PrimeiraOcorrencia As String
    Dim mVetor As Variant
    Dim Intervalo As Range
    Dim Contador As Long
    Dim I As Long
   Dim sCelPesquisa
   
   'Capturamos a linha em que estamos
   'Em seu Modelo é linha 24
   sCelPesquisa = ActiveCell.Row
    
    Dim NovaPlanilha As Worksheet
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    'Define o critério de buca em um array
     mVetor = Array(ActiveCell)
     
    With Sheets("Plan1").Range("A1:A1000")
        Contador = sCelPesquisa
        For I = LBound(mVetor) To UBound(mVetor)

            Set Intervalo = .Find(what:=mVetor(I), _
                                  after:=.Cells(.Cells.Count), _
                                  LookIn:=xlFormulas, _
                                  LookAt:=xlWhole, _
                                  SearchOrder:=xlByRows, _
                                  SearchDirection:=xlNext, _
                                  MatchCase:=False)
            
            If Not Intervalo Is Nothing Then
            Set NovaPlanilha = Sheets("Plan2")
         
                PrimeiraOcorrencia = Intervalo.Address
                Do
                    
                      Intervalo.Offset(0, 1).Copy Range("C" & Contador)
                      Intervalo.Offset(0, 2).Copy Range("B" & Contador)
                      Intervalo.Offset(0, 3).Copy Range("D" & Contador)
                     
                     'Acrescentamos + 1 para proxima linha
                     Contador = Contador + 1
                    
                    Set Intervalo = .FindNext(Intervalo)
                Loop While Not Intervalo Is Nothing And Intervalo.Address <> PrimeiraOcorrencia
            End If
        Next I
    End With
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

[]s

[rdvision]

rdvision, como eu disse com o modelo fica mais fácil entender.
Mas antes de utilizar o código você precisa estar atendo ao que eu disse anteriormente referente a questão de estarmos utilizando "ActiveCell", em seu modelo o nº 31 já está inserido em "A24", então para que a rotina funcione antes de roda-la esta Celula tem de estar selecionada, não sei como você fará a chamada a rotina mas tenha isto em mente, o ideal seria utilizarmos no Evento Change da planilha, ou seja sempre que a aba sofrer alguma alteração a macro é chamada e logicamente se for desta maneira devemos ajustar a rotina para captar qual celula estamos alterando e orientar na rotina se deve seguir ou não.

Voltando a sua rotina, segue com a adaptação para funcionar da forma que eu citei, a celula tem de estar selecionada antes:

Código: Selecionar todos

Sub teste()
Dim PrimeiraOcorrencia As String
    Dim mVetor As Variant
    Dim Intervalo As Range
    Dim Contador As Long
    Dim I As Long
   Dim sCelPesquisa
   
   'Capturamos a linha em que estamos
   'Em seu Modelo é linha 24
   sCelPesquisa = ActiveCell.Row
    
    Dim NovaPlanilha As Worksheet
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    'Define o critério de buca em um array
     mVetor = Array(ActiveCell)
     
    With Sheets("Plan1").Range("A1:A1000")
        Contador = sCelPesquisa
        For I = LBound(mVetor) To UBound(mVetor)

            Set Intervalo = .Find(what:=mVetor(I), _
                                  after:=.Cells(.Cells.Count), _
                                  LookIn:=xlFormulas, _
                                  LookAt:=xlWhole, _
                                  SearchOrder:=xlByRows, _
                                  SearchDirection:=xlNext, _
                                  MatchCase:=False)
            
            If Not Intervalo Is Nothing Then
            Set NovaPlanilha = Sheets("Plan2")
         
                PrimeiraOcorrencia = Intervalo.Address
                Do
                    
                      Intervalo.Offset(0, 1).Copy Range("C" & Contador)
                      Intervalo.Offset(0, 2).Copy Range("B" & Contador)
                      Intervalo.Offset(0, 3).Copy Range("D" & Contador)
                     
                     'Acrescentamos + 1 para proxima linha
                     Contador = Contador + 1
                    
                    Set Intervalo = .FindNext(Intervalo)
                Loop While Not Intervalo Is Nothing And Intervalo.Address <> PrimeiraOcorrencia
            End If
        Next I
    End With
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

[]s

Maravilhoso.....,
era isso ai.. tentarei agora fazer uma off set para o resultado fica uma ou duas linhas abaixo do célula de busca,
vc resolveu um grande problema, e este papo de apenas muito obrigado, não julgo ser o suficiente e até porque. talvez tenha que incomodar mais um pouco, pois este pequeno evento faz parte de um modulo maior que tento resolver, pois estou substituído uma planilha que se tornou lenta devido a muitas formulas pelo cod vb.
Grande, Mauro Coutinho!
muito grato mesmo, enviarei uma msg em particular pra vc, tentarei, pois pouco conheço o mecanismo aqui do fórum
Termino este tópico, como rapidamente resolvido.
Valeuuuu