VBA - Localizar valores e copiá-los

Question

Boa noite Pessoal,

Tenho uma macro que localiza um valor específico em um range específico e os pinta. Gostaria de alterá-la para, ao invés de pintar as células,  copiar os valores encontrados para a coluna ao lado.

A macro é essa:


Sub localiza()

'essa Macro procurar pelo valor TESTE no range A1:A10000 e pinta os resultados
'de ColorIndex = 15.

Dim localizador As Variant
With Plan1.Range("A1:A10000")
Set localizador = .Find("TESTE", LookIn:=xlValues)

If Not localizador Is Nothing Then
    endereco = localizador.Address
    Do
        localizador.Interior.ColorIndex = 15
           
        Set localizador = .FindNext(localizador)
Loop While Not localizador Is Nothing And localizador.Address <> endereco

End If
End With
End Sub



Podem me ajudar ?



Obrigado e Abraços!

Answer 1

Olá...Faça assim

Sub localiza()
    Dim localizador As Range
    With Plan1.Range("A1:A10000")
        Set localizador = .Find("TESTE", LookIn:=xlValues)
        If Not localizador Is Nothing Then
            ENDERECO = localizador.Address
            Do
                'localizador.Interior.ColorIndex = 15
                Range(localizador.Address).Offset(0, 1) = localizador.Value
                Set localizador = .FindNext(localizador)
            Loop While Not localizador Is Nothing And localizador.Address <> ENDERECO
        End If
    End With
End Sub
Se solucionar marque como resposta....Abraço..

Answer 2

EvangelistaLion,


Obrigado! Funcionou sim!

Outra coisa,


Tem como fazer com que os resultados sejam copiados para a coluna do lado mas a partir de uma célula específica. Por exemplo, sejam copiados para a coluna  B a partir da célula B2. ?


Valeu!

Answer 3

Olá....Tem sim...

Sub localiza()
    Dim localizador As Range, i As Long
    i = 2
    With Plan1.Range("A1:A10000")
        Set localizador = .Find("TESTE", LookIn:=xlValues)
        If Not localizador Is Nothing Then
            ENDERECO = localizador.Address
            Do
                'localizador.Interior.ColorIndex = 15
                Range("b" & i) = localizador.Value
                Set localizador = .FindNext(localizador)
                i = i + 1
            Loop While Not localizador Is Nothing And localizador.Address <> ENDERECO
        End If
    End With
End Sub


Se solucionar marque as resposta como respondida...Até...

Answer 4

EvangelistaLion,

Funcionou ok de novo.


Tenho só mais uma coisinha...


Se eu quiser ao invés de copiar somente a célula copiar a linha toda, como eu faria ?


Obrigado!!

Answer 5

Olá....Dá pra fazer assim....mas você terá que usar 2 planilhas....

Sub localiza()
    Dim localizador As Range, i As Long
    i = 2
    With Plan1.Range("A1:A10000")
        Set localizador = .Find("TESTE", LookIn:=xlValues)
        If Not localizador Is Nothing Then
            ENDERECO = localizador.Address
            Do
                Rows(localizador.Row).Copy
                Plan2.Select
                Plan2.Rows(i).Select
                Plan2.Paste
                Plan1.Select
                Set localizador = .FindNext(localizador)
                i = i + 1
            Loop While Not localizador Is Nothing And localizador.Address <> ENDERECO
        End If
    End With
    Application.CutCopyMode = False
End Sub


Se solucionar marque como resposta....Abraço..

Answer 6

Olá,

 

Sua resposta me ajudou também. Mas queria saber se é possível ao invés de copiar o valor da célula encontrada, copiar o valor da célula adjacente, à esquerda ou direita

Answer 7

Sim é possível sim. 

Não é difícil, basta usar esse comando logo após o código da célula encontrada. 

                                    Estou seguindo o último exemplo de código:
Rows(localizador.Row).Select                   <== aqui não se copia mais
ActiveCell.Offset(0, 1).Copy       <== aqui será copiada a celula a direita da encontrada.
                Plan2.Select                          continua as rotinas normalmente

Pronto!!! Boa sorte!!

Answer 8

Oi, a macro está pulando a primeira aparição do "teste". sabe pq? Estou usando assim:

    Dim localizador As Range, i As Long
    i = 2
    With Sheets("BASE_SAE").Range("R2:R1000")
        Set localizador = .Find("ERRO", LookIn:=xlValues)
        If Not localizador Is Nothing Then
            ENDERECO = localizador.Address
            Do
                Rows(localizador.Row).Copy
                Sheets("OCORRENCIAS").Select
                ActiveSheet.Rows(i).Select
                Selection.PasteSpecial Paste:=xlPasteValues
                Sheets("BASE_SAE").Select
                Set localizador = .FindNext(localizador)
                i = i + 1
            Loop While Not localizador Is Nothing And localizador.Address <> ENDERECO
        End If
    End With
    Application.CutCopyMode = False

a ideia é copiar para outra planilha a linha sempre que ele acha "ERRO" no range (r2:r1000), só que ele pula a 1a vez que o "erro" aparece, só vem do segundo em diante. sabe pq?

Answer 9

Boa tarde !!

EvangelistaLion aproveitei o código informado no blog aqui, adaptei para a minha realidade porém, quando compilo a macro ela até roda corretamente mas no fim emiti o erro:

Erro em tempo de execução '91'

A variável do objeto ou a variável do bloco 'With" não foi definida.

No código é sinalizado a linha de código: 

Loop While Not localizador Is Nothing And localizador.Address <> endereco

Consegue me ajudar neste caso?

Obrigado.

Abraço.

Answer 10

Boa tarde !!

EvangelistaLion aproveitei o código informado no blog aqui, adaptei para a minha realidade porém, quando compilo a macro ela até roda corretamente mas no fim emiti o erro:

Erro em tempo de execução '91'

A variável do objeto ou a variável do bloco 'With" não foi definida.

No código é sinalizado a linha de código: 

Loop While Not localizador Is Nothing And localizador.Address <> endereco

Consegue me ajudar neste caso?

Obrigado.

Abraço.