Este fórum está sendo desativado

[idaalexandra]

Ola.
Sou nova aqui e precisava de uma ajudinha.
Criei um ficheiro que serve para criar e registar encomendas. A encomenda e preenchida numa planilha e depois a macro copia os dados para uma tabela noutra. A macro que tenho é essa abaixo. Ela copia os diversos dados na folha de encomenda e cola na linha vazia da tabela da planilha Lista de Encomendas_Boavista. Agora gostaria que ela selecionasse o produto de baixo e copiasse os dados todos (fornecedor, data, referencia, etc.).

Folha de Encomenda


Lista de Encomendas


Sub Gravar_Encomenda()

' Copiar Fornecedores

Sheets("Nova Encomenda").Select
Range("B12:E14").Select
Selection.Copy
Sheets("Lista de Encomendas_Boavista").Select
Range("B5").Select
Do
If ActiveCell <> "" Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until ActiveCell = ""
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


' Fazer Referencia encomenda

Sheets("Nova Encomenda").Select
Range("J5").Select
Selection.Copy
Sheets("Lista de Encomendas_Boavista").Select
Range("C5").Select
Do
If ActiveCell <> "" Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until ActiveCell = ""
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


' Copiar Cliente

Sheets("Nova Encomenda").Select
Range("G20").Select
Selection.Copy
Sheets("Lista de Encomendas_Boavista").Select
Range("D5").Select
Do
If ActiveCell <> "" Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until ActiveCell = ""
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Copiar Nome Cliente

Sheets("Nova Encomenda").Select
Range("H20:J20").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Lista de Encomendas_Boavista").Select
Range("E5").Select
Do
If ActiveCell <> "" Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until ActiveCell = ""
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Data de Encomenda

Range("F5").Select
Do
If ActiveCell <> "" Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until ActiveCell = ""
Selection.FormulaR1C1 = "=TODAY()"

' Copiar Ref Produto

Sheets("Nova Encomenda").Select
Range("B20").Select
Selection.Copy
Sheets("Lista de Encomendas_Boavista").Select
Range("G5").Select
Do
If ActiveCell <> "" Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until ActiveCell = ""
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Copiar Produto

Sheets("Nova Encomenda").Select
Range("C20:D20").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Lista de Encomendas_Boavista").Select
Range("H5").Select
Do
If ActiveCell <> "" Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until ActiveCell = ""
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Copiar Quantidade

Sheets("Nova Encomenda").Select
Range("E20").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Lista de Encomendas_Boavista").Select
Range("I5").Select
Do
If ActiveCell <> "" Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until ActiveCell = ""
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Copiar Notas

Sheets("Nova Encomenda").Select
Range("B65:J66").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Lista de Encomendas_Boavista").Select
Range("M5").Select
Do
If ActiveCell <> "" Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until ActiveCell = ""
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Terminar

Range("B5").Select
Sheets("Nova Encomenda").Select
Range("B12:E14").Select

End Sub


A quem puder ajudar, obrigada.

[alexandrevba]

Bom dia!!

Poste seu arquivo modelo!

Para anexa um arquivo, ao responder a mensagem na parte de baixo tem (Opções | Adicionar um anexo), escolha o arquivo desejado.
Att

[idaalexandra]

Ja esta

[Feka]

Bom dia,

Para copiar a última linha preenchida da planilha "Nova Encomenda" use:

Dim a As Long
a = Sheets("Nova Encomenda").Range("b1048576").End(xlUp).Row
Sheets("Nova Encomenda").Range("b" & a & ":e" & a).Copy

agora apenas um conselho, evite usar o select quando não for necessário, ele torna mais extenso e lerdo sua macro.

[idaalexandra]

Bom dia,

Para copiar a última linha preenchida da planilha "Nova Encomenda" use:

Dim a As Long
a = Sheets("Nova Encomenda").Range("b1048576").End(xlUp).Row
Sheets("Nova Encomenda").Range("b" & a & ":e" & a).Copy

agora apenas um conselho, evite usar o select quando não for necessário, ele torna mais extenso e lerdo sua macro.

Agradeço a resposta,
Mas continua apenas a copiar a primeira linha dos produtos e eu gostaria que passasse para a segunda. Que copiasse todas as linhas preenchidas.

[Feka]

Você quer que copie todas as linhas preenchidas certo?

Veja se lhe atende, dessa vez eu testei na sua planilha e deu certo.

Dim a As Long
a = Sheets("Nova Encomenda").Range("c1048576").End(xlUp).Row
Sheets("Nova Encomenda").Range("b20:j" & a).Copy

[idaalexandra]

Pode enviar a macro completa? Estou a colar no inicio e continua a copiar apenas a primeira linha.

[Feka]

Ah! estava achando que você queria só a linha de código para copiar.

Segue anexo a macro completa, dá umas testada e me confirme se agora está ok.