Macro copiar linha a cima por criterio.

Question

Boa tarde pessoal, gostaria da ajuda do senhores.

Tenho uma planilha com as seguintes especificações:

Coluna A               Coluna B                              Coluna C               Coluna D
1                              FIAT                                     Palio                       2017
2                              FIAT                                     Palio                       2018

O que eu preciso é o seguinte, se na Coluna D, o ano for "2018"
A macro ira adicionar uma linha abaixo e Copiara os dados da linha de cima, porém agora colocando o ano de "2019".

Ficaria assim:

Coluna A               Coluna B                              Coluna C               Coluna D
1                              FIAT                                     Palio                       2017
2                              FIAT                                     Palio                       2018
3                              FIAT                                     Palio                       2019

Isso, em todos os anos que tiverem como 2018 apenas.

Consegui adicionar uma linha em branco sempre que encontrar o ano de "2018", porém não sei como copiar a valor da linha de cima e colar na nova criada alterando o ano...
O código que estou usando é o seguinte:

Sub Main()
Dim lRow As Long
Dim ws As Excel.Worksheet
Dim lLast As Long

Application.ScreenUpdating = False

Set ws = ActiveSheet
With ws
lLast = .Cells(.Rows.Count, "D").End(xlUp).Row
'Considernado uma linha de cabeçalho:
For lRow = lLast To 2 Step -1
If .Cells(lRow, "D") = "2018" Then
.Rows(lRow + 1).Insert
End If

Next lRow
End With

Application.ScreenUpdating = True

End Sub

Answer 1

H o r a c u l o,

     Alterei seu código, mas não sei se é o que você quer:

Sub Main()
Dim lRow As Long
Dim ws As Excel.Worksheet
Dim lLast As Long

    Planilha10.Select

    Application.ScreenUpdating = False

    Set ws = ActiveSheet
    
    With ws
        lLast = .Cells(.Rows.Count, "D").End(xlUp).Row
        
        'Considernado uma linha de cabeçalho:
        For lRow = lLast To 2 Step -1
        
            If .Cells(lRow, "D") = "2018" Then
                .Rows(lRow + 1).Insert
                
                .Cells(lRow + 1, "D") = "2019"
                .Cells(lRow + 1, "C") = .Cells(lRow, "C")
                .Cells(lRow + 1, "B") = .Cells(lRow, "B")
                .Cells(lRow + 1, "A") = .Cells(lRow, "A") + 1
                
                Exit For
            End If

        Next lRow

    End With

    Application.ScreenUpdating = True

End Sub

[]'s,
Fabio I.

Answer 2

H o r a c u l o,

     Alterei seu código, mas não sei se é o que você quer:

Sub Main()
Dim lRow As Long
Dim ws As Excel.Worksheet
Dim lLast As Long

    Planilha10.Select

    Application.ScreenUpdating = False

    Set ws = ActiveSheet
    
    With ws
        lLast = .Cells(.Rows.Count, "D").End(xlUp).Row
        
        'Considernado uma linha de cabeçalho:
        For lRow = lLast To 2 Step -1
        
            If .Cells(lRow, "D") = "2018" Then
                .Rows(lRow + 1).Insert
                
                .Cells(lRow + 1, "D") = "2019"
                .Cells(lRow + 1, "C") = .Cells(lRow, "C")
                .Cells(lRow + 1, "B") = .Cells(lRow, "B")
                .Cells(lRow + 1, "A") = .Cells(lRow, "A") + 1
                
                Exit For
            End If

        Next lRow

    End With

    Application.ScreenUpdating = True

End Sub

[]'s,
Fabio I.

Boa tarde Fabio, muito obrigado pela sua resposta... a ideia é exatamente essa, porém  a alteração não esta sendo feita em todos os anos (2018) encontrados, somente no ultimo... Exemplo:

Coluna A               Coluna B                              Coluna C               Coluna D
1                              FIAT                                     Palio                       2017
2                              FIAT                                     Palio                       2018
3                              FIAT                                     Siena                       2016

4                              FIAT                                     Siena                       2017
5                              FIAT                                     Palio                       2018

A macro esta deixando de realizar a alteração da linha 2 e fazendo somente a da ultima, na linha 5...

Preciso que ela o faça para todos os anos "2018" encontrados..

Answer 3

H o r a c u l o,

     Alterei seu código, mas não sei se é o que você quer:

Sub Main()
Dim lRow As Long
Dim ws As Excel.Worksheet
Dim lLast As Long

    Planilha10.Select

    Application.ScreenUpdating = False

    Set ws = ActiveSheet
    
    With ws
        lLast = .Cells(.Rows.Count, "D").End(xlUp).Row
        
        'Considernado uma linha de cabeçalho:
        For lRow = lLast To 2 Step -1
        
            If .Cells(lRow, "D") = "2018" Then
                .Rows(lRow + 1).Insert
                
                .Cells(lRow + 1, "D") = "2019"
                .Cells(lRow + 1, "C") = .Cells(lRow, "C")
                .Cells(lRow + 1, "B") = .Cells(lRow, "B")
                .Cells(lRow + 1, "A") = .Cells(lRow, "A") + 1
                
                Exit For
            End If

        Next lRow

    End With

    Application.ScreenUpdating = True

End Sub

[]'s,
Fabio I.

Entendi o que estava acontecendo Fábio, como você encerrou o laço de repetição do "for" ela só estava lendo uma vez (é claro), só precisei remover essa linha e tudo funcionou perfeitamente!!!

Muito obrigado pela sua ajuda, foi de grande contribuição para meu trabalho e aprendizado.

Answer 4

H o r a c u l o,

    Ops... desculpe! Eu encerrei com "Exit For" por que pensei que uma vez encontrado o "2018" já era o bastante...

    Fico feliz em ajudar, se é isso, então por favor, pode fechar o tópico?

[]'s,
Fabio I.

Answer 5

Bom, eu sou novo aqui e não encontrei a opção de "fechar tópico", espero que seja esse "Marcar como Resposta".

Mais uma vez, muito grato!

Answer 6

H o r a c u l o,

    Isso mesmo! Valew!

[]'s,
Fabio I.