Usuário com melhor resposta
Macro copiar linha a cima por criterio.

Pergunta
-
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
Respostas
-
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.- Editado Fabio I terça-feira, 5 de junho de 2018 16:12
- Marcado como Resposta H o r a c u l o terça-feira, 5 de junho de 2018 17:44
Todas as Respostas
-
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.- Editado Fabio I terça-feira, 5 de junho de 2018 16:12
- Marcado como Resposta H o r a c u l o terça-feira, 5 de junho de 2018 17:44
-
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 20164 FIAT Siena 2017
5 FIAT Palio 2018A 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..
-
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.
-
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.- Marcado como Resposta H o r a c u l o terça-feira, 5 de junho de 2018 17:43
- Não Marcado como Resposta H o r a c u l o terça-feira, 5 de junho de 2018 17:43
-
-