Boa tarde!!!

Segue um exemplo ....

Baixe o anexo..

Alexandre, consegui esta opção que me atendeu.

Sub TransfereRegistro()
Application.ScreenUpdating = False
Dim ws As Worksheet, LR, k As Long
Set ws = ThisWorkbook.Sheets("Plan1")
k = Application.CountA(ws.Range("E15:E21"))
If ws.[E9] = "" Then Exit Sub
With ThisWorkbook.Sheets("Plan2")
LR = .Cells(Rows.Count, 1).End(xlUp).Row
.Range(.Cells(LR + 1, 1), .Cells(LR + 1, 1).Offset(k - 1)) = ws.[E9]
.Range(.Cells(LR + 1, 2), .Cells(LR + 1, 2).Offset(k - 1)) = ws.[J9]
.Range(.Cells(LR + 1, 3), .Cells(LR + 1, 3).Offset(k - 1)) = ws.[K9]
.Range(.Cells(LR + 1, 4), .Cells(LR + 1, 4).Offset(k - 1)) = ws.[E12]
ws.Range("E15:J" & 15 + k - 1).Copy
.Cells(LR + 1, 5).PasteSpecial Paste:=xlPasteValues
ws.Range("E9,J9,K9,E12:J12,E15:J21").ClearContents
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True

silva_jmp

Pessoal, na postagem anterior, a macro buscava a quantidade de linhas preenchidas no campo dos itens, k = Application.CountA(ws.Range("E20:E25")) e repetiam outros dados conforme macro abaixo:
With ThisWorkbook.Sheets("RelVenda")
LR = .Cells(Rows.Count, 1).End(xlUp).Row
.Range(.Cells(LR + 1, 1), .Cells(LR + 1, 1).Offset(k - 1)) = ws.[E8]
.Range(.Cells(LR + 1, 2), .Cells(LR + 1, 2).Offset(k - 1)) = ws.[J8]
.Range(.Cells(LR + 1, 3), .Cells(LR + 1, 3).Offset(k - 1)) = ws.[K8]
.Range(.Cells(LR + 1, 4), .Cells(LR + 1, 4).Offset(k - 1)) = ws.[E12]
ws.Range("E20:J" & 20 + k - 1).Copy
.Cells(LR + 1, 5).PasteSpecial Paste:=xlPasteValues

Mas agora minha necessidade e o seguinte, quando informo na célula C29 a condição de pagamento aparece na células G29:G31 as data de vencimento, preciso que ao salvar busque, a ou as datas de vencimento por item lançado nas células E20:E25, melhor explicação e entendimento da necessidade em anexo.

silva_jmp

Boa tarde!!!

Segue um exemplo ....

Baixe o anexo..

MUITO BOM !! COMO FAÇO PARA QUANDO TRANSFERIR NÃO LIMPARA AS INFORMÇÕES DA PLAN 1 ??
VALEU

Boa tarde Samule

Experimente retirar esta linha:

ws.Range("E9,J9,K9,E12:J12,E15:J21").ClearContents

Abraço.