none
Planilha para Localizar valores de uma planilha e copiar a coluna correspondente do valor localizado para outra planilha. RRS feed

  • Pergunta

  • Olá,

    Estou a uns dias trabalhando em uma planilha porém não tenho obtido sucesso da maneira esperada.

    A idéia é ter um botão de comando que ao clicá-lo rode uma macro que busque os valores "r" por coluna na planilha 2, e ao encontrá-los, copie apenas os nomes referentes a linha em que o "r" fora encontrado para a planilha 1 coluna A.

    E caso nenhum valor seja encontrado na busca, copiar apenas os nomes referentes a linha em quem nenhum valor tenha sido encontrado para a planilha 1 coluna B. Segue modelo abaixo:

    A                                                                                  E                     F                G                   H                   I

    João r
    carlos
    bryan r r
    tommy
    aaron r r r
    tj r
    hank r
    walt r r r
    gus r
    mike r r r
    saul
    haas r
    almeida r
    callegaro r r
    tiago r

    Criei um código no VBA para encontrar o valor e copiar o endereço do valor encontrado para a planilha 1. Porém o código possui erros de compilação e acaba por não funcionar. Além disso não obti sucesso diante do fato de que caso o valor não seja encontrado, os nomes referentes sejam copiados. Acredito que tenha que ser criada uma variável para atribuir valor, porém estou empacado. Segue o código abaixo:

     Private Sub CommandButton1_Click()

    Dim c As Range
    Dim firstaddress As String

        With Sheets("plan2").Range("E2:I16")
            
            Set c = .Find(What:="r", LookIn:=xlFormulas, Lookat:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, Searchformat:=False)
            
            firstaddress = c.Address
            
            If Not c Is Nothing Then
            
            Do
            
            Range(c.Address).Select
            Selection.Copy
            Sheets("plan1").Select
            Range("A2").Select
            Sheets("Plan1").Paste
            
            Set c = .FindNext(c)
            
            Loop While c Is Nothing
            
            End If
            
        End With
        
    End Sub


    Gostaria da sugestão de vocês para me auxiliar na solução deste meu problema.

    Agradeço desde já,

    Marcelo

    quarta-feira, 12 de fevereiro de 2014 22:36

Respostas

  • Como sou iniciante no VBA pode ter alguma forma mais fácil, porém esta funciona bem.

    copie o código para algum módulo e depois chame ele em qualquer botão.

     
    Sub teste()
    
    linha = 1
    coluna = 5
    linhac = 1
    linhad = 1
    
    Do Until Sheets("Plan2").Cells(linha, 1) = ""
    
    coll:
        If Sheets("plan2").Cells(linha, coluna) = "r" Then
        Sheets("Plan2").Select
        Cells(linha, 1).Copy
        Sheets("Plan1").Select
        Cells(linhac, 1).Select
        ActiveSheet.Paste
        linhac = linhac + 1
    
        Else
            For coluna = coluna To 10
            coluna = coluna + 1
            GoTo coll
            Next coluna
            Sheets("Plan2").Select
            Cells(linha, 1).Copy
            Sheets("Plan1").Select
            Cells(linhad, 2).Select
            ActiveSheet.Paste
            linhad = linhad + 1
    
        End If
        linha = linha + 1
        coluna = 5
    Loop
    
    
    End Sub
    

    quinta-feira, 13 de fevereiro de 2014 22:52

Todas as Respostas

  • Como sou iniciante no VBA pode ter alguma forma mais fácil, porém esta funciona bem.

    copie o código para algum módulo e depois chame ele em qualquer botão.

     
    Sub teste()
    
    linha = 1
    coluna = 5
    linhac = 1
    linhad = 1
    
    Do Until Sheets("Plan2").Cells(linha, 1) = ""
    
    coll:
        If Sheets("plan2").Cells(linha, coluna) = "r" Then
        Sheets("Plan2").Select
        Cells(linha, 1).Copy
        Sheets("Plan1").Select
        Cells(linhac, 1).Select
        ActiveSheet.Paste
        linhac = linhac + 1
    
        Else
            For coluna = coluna To 10
            coluna = coluna + 1
            GoTo coll
            Next coluna
            Sheets("Plan2").Select
            Cells(linha, 1).Copy
            Sheets("Plan1").Select
            Cells(linhad, 2).Select
            ActiveSheet.Paste
            linhad = linhad + 1
    
        End If
        linha = linha + 1
        coluna = 5
    Loop
    
    
    End Sub
    

    quinta-feira, 13 de fevereiro de 2014 22:52
  • Isso resolveu meus problemas! Vou adaptar a minha planilha! Muito obrigado pela ajuda!

    Abraço,

    Marcelo

    domingo, 16 de fevereiro de 2014 12:16