Este fórum está sendo desativado

[Leonardo1234]

Olá Pessoal,

Eu preciso de uma macro que insira uma nova linha na tabela copiando os valores da linha de cima sempre que o valor de uma determinada célula dessa mesma linha de cima for maior do que zero. Eu preciso também que se nessa mesma linha de cima, o valor dessa célula de referência voltar a ser igual a zero, a linha que havia sido inserida se exclua novamente. É bom ressaltar que essa exclusão deve ocorrer apenas sobre novas linhas inseridas e não sempre que o valor for igual a zero e onde não houve a ação de inclusão de uma nova linha.

Vou deixar a planilha em anexo como exemplo onde eu deixei destacado em vermelho uma linha que eu inseri manualmente como exemplo. A célula de referência onde a regra ">0" se aplica acionando a macro, é a célula da linha de cima da coluna N. No exemplo, eu a deixei destacada em roxo. É bom lembrar que o valor da célula N é resultado de uma fórmula, não sei se isso pode alterar algo para o desenvolvimento da macro. Eu também deixei destacado em amarelo, duas células de exceção da nova linha inserida, que não devem ser copiadas de forma igual às células da linha de cima. No caso da coluna D, a célula sempre deve ser preenchida com a palavra Posto, e na coluna F, o valor sempre deve ser igual à soma do valor da coluna F +coluna M da linha de cima. O resto fica tudo igual, também lembrando que não apenas os valores devem ser copiados, como também as fórmulas. A coluna P é um exemplo onde os valores são diferentes, porém a fórmula é igual, arrastando apenas os intervalos da fórmula. Seria ótimo se a macro agisse automaticamente assim que o valor da célula N fosse alterado sem a necessidade de botoes para chamar a macro.

Agradeço muito a ajuda

Segue a planilha em anexo.

[mucascosta]

Código: Selecionar todos

‘Para você adaptar ao seu projeto:

‘EM UM MÓDULO
Sub InserirExcluir()
    With ThisWorkbook.Sheets("Base")
        Dim linhaAtual, linhaFinal As Long
        linhaAtual = ActiveCell.Row - 1
        linhaFinal = ActiveCell.Row - 1
            If UCase(Cells(linhaAtual, "N")) > 0 Then
                Rows(linhaAtual + 1).Select
                Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Rows(linhaAtual).Copy
                Rows(linhaAtual + 1).Select
                ActiveSheet.Paste
                Range("D" & linhaAtual + 1) = "Posto"
                Range("F" & linhaAtual + 1) = ""
                Application.CutCopyMode = False
            ElseIf UCase(Cells(linhaAtual, "N")) = 0 Or UCase(Cells(linhaAtual, "N")) = "" Then
                Rows(linhaAtual).Select
                Selection.Delete
            End If
        MsgBox "Sucesso!", vbInformation, "© Muca Sistemas"
    End With
End Sub

‘NO EVENTO AO ALTERAR DA ABA BASE:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column <> 14 Then Exit Sub
    InserirExcluir
End Sub

[Leonardo1234]

OLá MucascOSTA, agradeço a ajuda, porém a macro não funcionou. Ela deu erro nessas duas partes alegando erro de sintaxe:

‘NO EVENTO AO ALTERAR DA ABA BASE:

Selection.Delete

Consegue arrumar? Muito obrigado.

[Leonardo1234]

MucaCosta, eu exclui essas partes e aparentemente a macro rodou, porém ela não está agindo como deveria. Talvez seja mais facil separar as ações de incluir e excluir em duas macros diferentes. Acredito que isso pode estar atrapalhando.

[mucascosta]

Veja se resolve substituindo por Selection.Delete Shift:=xlUp

[Leonardo1234]

Não está indo. Você conseguiria fazer uma macro que faz apenas a inclusão das linhas respeitando os mesmos parametros que eu coloquei? Acho que vai ficar melhor do que excluir na própria macro. Muito obrigado.

[mucascosta]

Se quer só inclusão, exclua essa parte da macro: ElseIf UCase(Cells(linhaAtual, "N")) = 0 Or UCase(Cells(linhaAtual, "N")) = "" Then
Rows(linhaAtual).Select
Selection.Delete

[Leonardo1234]

Olá Mucascosta, deve ter algum problema na macro, ela não está produzindo qualquer efeito sobre a planilha, com a parte de exclusão das linhas cortada. Consegue verificar? Agradeço muito se conseguir. As linhas em vermelho são exemplos, onde abaixo delas deve ser inserida uma nova linha com as especificações que eu já mencionei. Obrigado.

[mucascosta]

O evento abaixo não fica no Módulo1 pois se refere a ocorrência na Aba Base:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 14 Then Exit Sub
InserirExcluir
End Sub

Click lado direito do mouse na Aba Base, em seguida click em Exibir Código, finalmente cole o evento acima.

[Leonardo1234]

Ainda não está dando certo. Vou te mandar a planilha. Só para enfatizar novamente, a inclusão das linhas só deve ocorrer onde as linhas da tabela estão vermelhas, que é onde os valores da coluna N são maiores que zero e onde na linha abaixo delas, nas colunas D e E, as células são diferentes de posto. A inclusão de uma nova linha só deve ocorrer sob essas duas condições, copiando as informações da linha de cima, com exceção das colunas D e E, onde ambas devem ser preenchidas com a palavra "Posto" e na célula F, onde ela deve ser igual a soma da célula F da linha de cima mais a célula da coluna M da linha de cima. O resto deve ser tudo igual, e como já mencionei antes, nas células com fórmulas, os valores não devem ser copiados, mas sim as fórmulas devem ser apenas arrastadas. Agradeço novamente as tentativas. Segue anexo.

[mucascosta]

Precisa resolver/esclarecer:

- A célula “N”, onde a regra ">0" se aplica, tem fórmula. Como pretende alterá-la (direta ou através de fórmula)?

- A planilha anexada possui três tabela distintas...

- Até a linha 6 não permite inclusão de linhas.

[Leonardo1234]

A célula “N”, onde a regra ">0" se aplica, tem fórmula. Como pretende alterá-la (direta ou através de fórmula)?

Resposta: A alteração da célula N se dá através de uma fórmula que possui vinculo com a tabela "Abastecimento", que é a tabela em seguida a ela na direita. Você pode perceber que os valores "15, 30, 50, e 80" são os mesmos que a coluna V da tabela "Abastecimento".

A planilha anexada possui três tabela distintas...

A terceira tabela não possui qualquer vinculo com a primeira.

Até a linha 6 não permite inclusão de linhas

Não entendi direito essa parte, pois na minha planilha é possível inserir linhas até a ultima linha da tabela.


Vou enfatizar novamente uma regra que é muito importante para que a macro funcione corretamente. Além do valor da célula N ser maior que zero, os valores da células da colunas D e E da linha de baixo devem ser diferentes da palavra "Posto". Exemplo: Se na linha 5, o valor da célula N é maior que zero e na linha 6, os valores das células D e E são iguais a "Posto", não deve haver a inclusão de uma nova linha. Caso contrário, isto é, elas forem diferente de "Posto", aí a macro inclui uma nova linha.

[mucascosta]

"Não entendi direito essa parte, pois na minha planilha é possível inserir linhas até a ultima linha da tabela."

Tente incluir, manualmente, linhas na última planilha anexada...

[Leonardo1234]

Segue arquivo com as linhas incluídas. É só clicar com o botão direito dentro de uma célula da tabela e incluir.

[mucascosta]

Mais uma tentativa! click no botão Atualizar.

[Leonardo1234]

Está quase lá. A macro não está considerando a regra, onde além do valor da célula N ter que ser maior que zero, os valores das células das colunas D e E da linha de baixo devem ser diferentes da palavra "Posto". Você pode perceber que na segunda vez que a macro é acionada, novas linhas são adicionadas, mesmo onde já houve a inclusão de novas linhas com a palavra "Posto" pelo primeiro acionamento a macro. Além disso, a macro não está preenchendo a célula F com a soma das células F e M da linha de cima. Mais uma coisa, eu não sei o que exatamente foi feito, mas a macro está tendo algum efeito sobre as formulas. Pelo o que percebi, elas não estão funcionando automaticamente como o normal, funcionando apenas quando um novo enter é feito sobre elas.

[mucascosta]

Código: Selecionar todos

Sub AddLinhas()
Dim iRow As Integer, iCol As Integer
Dim oRng As Range
Dim linhaAtual As Long
Set oRng = Range("N1")
iRow = oRng.Row
iCol = oRng.Column

Do

If Cells(iRow + 1, iCol) > 0 And Cells(iRow + 1, 19) <> "X" Then
   Cells(iRow + 2, iCol).Select
   Selection.ListObject.ListRows.Add (iRow + 1)
   Cells(iRow + 1, iCol).Select
   linhaAtual = ActiveCell.Row
   Range("A" & linhaAtual & ":R" & linhaAtual).Copy
   Range("A" & linhaAtual + 1).Select
   ActiveSheet.Paste
   Range("D" & linhaAtual + 1) = "Posto"
   Range("E" & linhaAtual + 1) = "Posto"
   Range("S" & linhaAtual) = "X"
   Range("S" & linhaAtual + 1) = "X"
   Application.CutCopyMode = False
   iRow = iRow + 2
Else
   iRow = iRow + 1
End If

Loop While Not Cells(iRow, iCol).Text = ""

MsgBox "Sucesso!", vbInformation, "© Muca Sistemas"

End Sub

[Leonardo1234]

Ainda não está dando certo.

Está aparecendo esse erro um pouco antes da macro finalizar:

Erro em tempo de execução '91':
A variável do objeto ou a variável do bloco 'With' não foi definida

Além disso, a macro continua produzindo algum efeito sobre as formulas, as fazendo parar de funcionar. Você pode perceber que todos os valores da coluna N até a coluna R estão zerados, onde antes possuíam valores resultantes das formulas. A macro também está inserindo uma nova coluna na tabela sem necessidade, a coluna S.

[mucascosta]

Leonardo1234, testei aqui e funcionou perfeitamente...
Entendo que já colaborei para o desenvolvimento do seu projeto.
Existem particularidades em sua planilha que que não são de meu conhecimento.
Então, pra você fica mais fácil resolver pendências eventualmente surgidas...
Agora é com você!

[mucascosta]

Testa o anexo.