Cópia de dados entre planilhas

2024 - VBA & Macros

Post Recente por Nill2013Br 7 anos atrás

3 Posts

2 Usuários

0 Reactions

879 Visualizações

RSS

Nill2013Br

(@nill2013br)

Posts: 19

Active Member

Topic starter

Tenho um código para copiar os itens com quantidade na plan1 para a plan2 sem os intervalos vazios, que antes de copiar apaga os dados da plan2. Gostaria de saber como faço para manter os dos copiados anteriormente e que a nova entrada de dados seja feito na sequencia das células vazias. Agradeço a atenção.

Sub Copiar()
    Plan2.Range("A2:E100").ClearContents
    UltimaLinhaAtiva = Plan1.Cells(Rows.Count, "a").End(xlUp).Row
    lin = 2
    For i = 2 To UltimaLinhaAtiva
        If Plan1.Cells(i, 5) <> "" Then
           Plan2.Cells(lin, 1) = Plan1.Cells(i, 1)
           Plan2.Cells(lin, 2) = Plan1.Cells(i, 2)
           Plan2.Cells(lin, 3) = Plan1.Cells(i, 3)
           Plan2.Cells(lin, 4) = Plan1.Cells(i, 4)
           Plan2.Cells(lin, 5) = Plan1.Cells(i, 5)
           lin = lin + 1
        End If
           
    Next

Postado : 12/03/2018 10:32 am

Wagner Morel

(@wagner-morel-vidal-nobre)

Posts: 0

Illustrious Member

Nill2013Br,

Boa tarde!

Basta substituir por esse código (pequenas alterações).

Sub Copiar()
    'Plan2.Range("A2:E100").ClearContents
    UltimaLinhaAtiva = Plan1.Cells(Rows.Count, "a").End(xlUp).Row
    lin = Plan2.Cells(Rows.Count, "a").End(xlUp).Row + 1
    
    'lin = 2
    For i = 2 To UltimaLinhaAtiva
        If Plan1.Cells(i, 5) <> "" Then
           Plan2.Cells(lin, 1) = Plan1.Cells(i, 1)
           Plan2.Cells(lin, 2) = Plan1.Cells(i, 2)
           Plan2.Cells(lin, 3) = Plan1.Cells(i, 3)
           Plan2.Cells(lin, 4) = Plan1.Cells(i, 4)
           Plan2.Cells(lin, 5) = Plan1.Cells(i, 5)
           'lin = lin + 1
        End If
           
    Next

End Sub

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

Postado : 12/03/2018 10:46 am