Copiar Dados de Uma Aba para Outra

#1

Boa Noite a Todos,

Sou novo aqui no forum de já quero agradecer a todos pela ajuda que tenho recebido por aqui.

Nessa oportunidade trago um código que estou utilizando para copiar dados da (PlanProduto) para (PlanDestino) baseado em Critério “FECHADO”, porem encontrei uma dificuldade e não estou conseguindo, todas as vezes que faço a copia ele substitui os dados, Tipo, faço a copia de 10 registro em um dia, e no dia seguinte tenho que copiar mais 15 registro, e o que quero é mater todos já copiados anteriormente, para uma consulta futura de todos. logo então a ideia é ir gerando a sequencia sem perder dados.

Abaixo o código que utilizo.

Sub Copiar_Dados ()
Dim i As Range
Dim PrimeiraLinha As Integer
Dim LinDestino As Integer
LinDestino = 2

Set i = PlanProdutos.Range(“A:A”).Find(“FECHADO”)
On Error Resume Next
PrimeiraLinha = i.Row

Do

PlanProdutos.Range(“A” & i.Row & “:D” & i.Row).Copy PlanDestino.Range(“A” & LinDestino)

LinDestino = LinDestino + 1
Set i = PlanProdutos.Range(“A:A”).FindNext(i)
Loop While PrimeiraLinha < i.Row

#2

Boas, veja se é isto que pretende. :slight_smile:

Sub Copiar_Dados()
'Revisado por:InforMira
'Contacto: [email protected]
'Data de revisamento: 19/01/2021

Dim i As Range
Dim PrimeiraLinha As Integer, LinDestino As Integer

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
    .Calculation = xlCalculationManual
End With

LinDestino = Sheets("PlanDestino").Cells(Rows.Count, 1).End(xlUp).Row

Set i = Sheets("PlanProdutos").Range("A:A").Find("FECHADO")
On Error Resume Next
PrimeiraLinha = i.Row

Do

 Sheets("PlanProdutos").Range("A" & i.Row & ":D" & i.Row).Copy Sheets("PlanDestino").Range("A" & LinDestino + 1)

LinDestino = LinDestino + 1
Set i = Sheets("PlanProdutos").Range("A:A").FindNext(i)
Loop While PrimeiraLinha < i.Row

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
    .Calculation = xlCalculationAutomatic
End With

End Sub
#3

Boa Noite!

obrigado pela super dica, fiz adaptação para minha planilha padrão, porem a copia não passa para planilha na linha certa,

tens algum e-mail pra eu enviar o modelo pra você fazer um teste?

#4

Sim pode enviar para [email protected]
:slight_smile: