Notifications
Clear all

Cópia de dados entre planilhas

3 Posts
2 Usuários
0 Reactions
888 Visualizações
(@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
(@nill2013br)
Posts: 19
Active Member
Topic starter
 

Obrigado Wagner, funcionou perfeitamente.

 
Postado : 12/03/2018 12:37 pm