none
VBA - Localizar valores e copiá-los RRS feed

  • Pergunta

  • 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!
    sexta-feira, 5 de fevereiro de 2010 00:52

Respostas

  • 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..
    • Marcado como Resposta john.law domingo, 7 de fevereiro de 2010 12:26
    sexta-feira, 5 de fevereiro de 2010 11:29
  • 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é...
    • Marcado como Resposta john.law domingo, 7 de fevereiro de 2010 12:26
    sábado, 6 de fevereiro de 2010 20:44
  • 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..
    • Marcado como Resposta john.law sexta-feira, 5 de março de 2010 01:56
    segunda-feira, 8 de fevereiro de 2010 11:26

Todas as Respostas

  • 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..
    • Marcado como Resposta john.law domingo, 7 de fevereiro de 2010 12:26
    sexta-feira, 5 de fevereiro de 2010 11:29
  • 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!

    sábado, 6 de fevereiro de 2010 10:30
  • 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é...
    • Marcado como Resposta john.law domingo, 7 de fevereiro de 2010 12:26
    sábado, 6 de fevereiro de 2010 20:44
  • 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!!
    domingo, 7 de fevereiro de 2010 12:22
  • 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..
    • Marcado como Resposta john.law sexta-feira, 5 de março de 2010 01:56
    segunda-feira, 8 de fevereiro de 2010 11:26
  • 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

    • Sugerido como Resposta frank.alves sexta-feira, 23 de novembro de 2012 17:03
    • Não Sugerido como Resposta frank.alves sexta-feira, 23 de novembro de 2012 17:05
    quarta-feira, 11 de maio de 2011 14:17
  • 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!!

    segunda-feira, 10 de outubro de 2016 23:26
  • 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?

    quinta-feira, 25 de maio de 2017 01:33
  • 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.

    quarta-feira, 7 de março de 2018 17:27
  • 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.


    quarta-feira, 7 de março de 2018 17:28