MACRO para inserir linhas e copiar as anteriores

[lucasbelfort]

Pessoal,

Estou fazendo uma planilha de controle. As funções e fórmulas já estão todas prontas.

O que necessito é inserir 3 linhas em branco entre cada linha laranja e copiar as 3 linhas brancas anteriores.

Na imagem abaixo está a planilha, aí da pra entender melhor o que preciso.

Muito obrigado a quem puder me ajudar!

[jeffsilveira]

Lucas, por favor, envie sua planilha ao invés de uma imagem.

Use sendspace.com ou similar.

A imagem não nos ajuda em nada...

No aguardo.

[lucasbelfort]

Amigo muito obrigado pela disponibilidade em ajudar.

Desculpe pela demora pois saí de férias.

http://www.sendspace.com/file/nsifor

Segue a planilha em anexo.

A macro seria para as sheets ACOPLAMENTO e SOLDAGEM.

Obrigado

[jeffsilveira]

Lucas, tente a macro abaixo, serve para as duas planilhas.

Ela varre a partir da linha 20 buscando duas células laranjas seguidas. Se encontrar, copia as linhas 16:18 e insere colando entre as linhas encontradas.

Mas tenha paciência, sua planilha é imensa e o procedimento será demorado, bem demorado.

Sub Macro1()
'desabilita atualização de tela
Application.ScreenUpdating = False
'executa em todas as linhas preenchidas
For i = 20 To Cells(Rows.Count, 1).End(xlUp).Row
    'se duas linhas seguidas forem laranja
    If Cells(i, 1).Interior.ThemeColor = xlThemeColorAccent6 And _
    Cells(i + 1, 1).Interior.ThemeColor = xlThemeColorAccent6 Then
    'copia as linhas 16:18
    Rows("16:18").Copy
    'insere colando no local adequado
    Rows(i + 1).Insert Shift:=xlDown
    End If
Next
Application.CutCopyMode = False
'habilita atualização de tela
Application.ScreenUpdating = True
End Sub

Dê retorno.

[lucasbelfort]

Meu querido Jeff, muitíssimo obrigado, ficou quase perfeita!

Muito bom pra começar e você fez em pouco tempo.

Diminui consideravelmente o número de linhas para testar e percebi que as linhas são adicionadas aos poucos. A primeira vez que roda a macro ela abre espaço entre 4 intervalos de linhas laranjas. Na segunda fez entre 3 linhas laranjas. Na terceira vez entre 2 linhas laranjas e depois tem que rodar a macro cada vez que for abrir o espaço nas demais linhas laranjas restantes.

Segue em anexo a planilha diminuída já com o botão da macro para você visualizar melhor o que acontece.

http://www.sendspace.com/file/0l81bv

[jeffsilveira]

** Lucas, verdade, foi uma pequena falha minha.

A macro deve ser executada de baixo para cima ao invés de cima para baixo.

Substitua a linha:

For i = 20 To Cells(Rows.Count, 1).End(xlUp).Row

Por esta:

For i = Cells(Rows.Count, 1).End(xlUp).Row To 20 Step -1

Teste aí e dê retorno.

Abraços.

[lucasbelfort]

Meu querido, deu certinho, sou eternamente grato!!!

Uma pergunta:

Quanto tempo você acha que demora para rodar a macro nas 6000 linhas??

Abraço

[jeffsilveira]

Vish, sei lá!

Põe pra rodar na hora que você for dar uma saída, almoçar, e pega depois!

Os comandos da macro são simples, mas é muito conteúdo, então vai demorar um bocado!

Abraços.

[lucasbelfort]

Fala Jeff!

Ta dando tudo certo mas realmente demorando mt, mais de 20 horas.

Notei 2 coisas:

Que no inicio ele faz o processo mt rápido e a medida que vão passando as linhas, vai ficando mt mais lento.

E se eu deletar as outras sheets tambem vai bem mais rápido.

Sera que tem um comando que faça rodar a macro somente na sheet em questão??

Obrigado uma vez mais