none
Macro copiar linha a cima por criterio. RRS feed

  • 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
    terça-feira, 5 de junho de 2018 15:28

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
    terça-feira, 5 de junho de 2018 16:10

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
    terça-feira, 5 de junho de 2018 16:10
  • 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..


    terça-feira, 5 de junho de 2018 16:49
  • 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.

    terça-feira, 5 de junho de 2018 16:56
  • 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
    terça-feira, 5 de junho de 2018 17:27
  • 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!

    terça-feira, 5 de junho de 2018 17:52
  • H o r a c u l o,

        Isso mesmo! Valew!

    []'s,
    Fabio I.

    terça-feira, 5 de junho de 2018 19:40