Ir ao conteúdo
  • Cadastre-se
LaerteB

Copiar linhas na cor amarela de uma planilha e colar em outra via vba

Recommended Posts

Boa tarde, pessoal!

 

Estou com dificuldades em completar meu código em vba.. o que quero fazer é copiar as linhas em amarelo em outra planilha, mas na planilha (Plan1), tem as cores vermelha e amarela nas linhas.

Desta forma eu pesquisei e efetuei estes códigos abaixo, só que não está funcionando:

Sub relatorio()

    Plan2.Range("A3:D100").ClearContents
    ultimaLinha = Plan1.Cells(Rows.Count, "d").End(xlUp).Row
    Dim n As ColorScale
    
    lin = 3
    For i = 4 To ultimaLinha
       
        If Plan1.Cells(i, 4) = Interior.ColorIndex = 27 Then
                     
           Plan2.Cells(lin, 1) = Plan1.Cells(i, 4)
           Plan2.Cells(lin, 2) = Plan1.Cells(i, 5)
           Plan2.Cells(lin, 3) = Plan1.Cells(i, 6)
           Plan2.Cells(lin, 4) = Plan1.Cells(i, 7)
           lin = lin + 1

        End If
    Next
End Sub

Verifiquei que na linha If Plan1.Cells(i,4) = Interrior.ColorIndex = 27 Then está dando o erro 424 - O objeto é obrigatório- eu tentei fazer de outras maneiras, mas sem efeito.

Gostaria que me dessem uma luz qual maneira para que copie somente as linhas amarelas das colunas 4 a 7 e colocá-las na Plan2 como descrito acima.

 

Agradeço desde já.

Compartilhar este post


Link para o post
Compartilhar em outros sites

@LaerteB teria que analisar melhor seu arquivo, se as linhas em amarelo são coloridas por formatação condicional, este codigo não funcionará.

Se puder compartilhar seu arquivo ou um exemplo bem proximo do original com alguns dados ficticios.

 

Segue o codigo com as alteraçoes: 

 

	Sub relatorio()
  Dim ultimaLinha As Long, i As Long, lin As Long
  
    Plan2.Range("A3:D100").ClearContents
    ultimaLinha = Plan1.Cells(Rows.Count, "d").End(xlUp).Row
    Dim n As ColorScale
    
    lin = 3
    For i = 4 To ultimaLinha
       
        If Plan1.Cells(i, 4).Interior.ColorIndex = 27 Then
                     
           Plan2.Cells(lin, 1) = Plan1.Cells(i, 4)
           Plan2.Cells(lin, 2) = Plan1.Cells(i, 5)
           Plan2.Cells(lin, 3) = Plan1.Cells(i, 6)
           Plan2.Cells(lin, 4) = Plan1.Cells(i, 7)
           lin = lin + 1
	        End If
    Next
End Sub
	

  • Curtir 1

Compartilhar este post


Link para o post
Compartilhar em outros sites

Boa noite, Basole!

 

Obrigado por responder; primeira pergunta é sim, estou disponibilizando abaixo o arquivo teste para vocês verificarem melhor (com dados fictícios e só as colunas principais preenchidas para exemplificar).

A Segunda pergunta é não são coloridas por formatação condicional e sim manualmente.

https://www.sendspace.com/file/lbrmgn

 

O seu código com alterações, eu implementei, mas novamente deu o mesmo erro que citei antes.

Ficarei no aguardo, espero que o arquivo acima ajude.. e agradeço muito. Valeu.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Bom dia Pessoal!

 

Estou ainda com dificuldades, como citado na mensagem acima, se alguém tiver alguma sugestão pode responder este tópico.. agradeço muito.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Olá, Basole

 

Muito obrigado, agora funcionou como eu queria.. eu tenho a tabela de cores, mas a cor amarela número 6 não tinha testado.. o número 27 (amarelo), tem uma tonalidade ligeiramente diferente e não tinha percebido... valeu mesmo.

Como sempre faço, estou disponibilizando "abaixo" o código já com a correção da cor, para que se houver outra pessoa com a mesma dificuldade utilizar mudando de acordo com o seu projeto:

 

Sub relatorio()

Dim ultimaLinha As Long, i As Long, lin As Long

    Plan2.Range("A3:D100").ClearContents
    ultimaLinha = Plan1.Cells(Rows.Count, "d").End(xlUp).Row
       
    lin = 3
    For i = 4 To ultimaLinha
       
        If Plan1.Cells(i, 4).Interior.ColorIndex = 6 Then ' (6 = amarelo)
        
           Plan2.Cells(lin, 1) = Plan1.Cells(i, 4)
           Plan2.Cells(lin, 2) = Plan1.Cells(i, 5)
           Plan2.Cells(lin, 3) = Plan1.Cells(i, 6)
           Plan2.Cells(lin, 4) = Plan1.Cells(i, 7)
           lin = lin + 1

        End If
    Next
End Sub

Thank You, e uma ótima semana para ti.

 

  • Curtir 1

Compartilhar este post


Link para o post
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisar ser um membro para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora





Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×