Experiemente colar esse codigo em um modulo ou botao active x
Sub Expedição()
Application.ScreenUpdating = False
Sheets("Patio").Select
Range("J7").Select
Do While ActiveCell <> ""
If ActiveCell.Value = "Sim" Then
Intersect(Selection.EntireRow, Range("A:I")).Select
Selection.Copy
Sheets("Expedidas").Select
Range("A1048576").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, 9).Select
ActiveCell.Value = Date
Range("A7").Select
Sheets("Patio").Select
ActiveCell.EntireRow.Delete
ActiveCell.Offset(0, 9).Select
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
Range("A7").Select
MsgBox "Expedição Realizada Com Sucesso", vbOKOnly, "Atenção"
Application.ScreenUpdating = True
End Sub
Marcelo Prudencio
Microsoft Excel Brasil no Facebook
"Começar já é a metade do caminho."
Autor Desconhecido
Simplifica que simples fica.
Nicole Tomazella.
"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.
Postado : 12/09/2015 11:00 am