Boa noite!!!
Vou deixar as partes vermelhas com você, caso tenha problema retorne, não se esqueça da mãozinha
Troque seu modulo 8 pelo código..
Option Explicit
Sub Click_Maozinha()
Dim i As Long
Application.ScreenUpdating = False
For i = 0 To 6
If Range("D20").Offset(i) <> "" Then
Call Lookups(Range("D20").Offset(i), Range("E20:J20").Offset(i))
Else
Range("E20:J20").Offset(i).ClearContents
End If
Next
Call Ordem
Application.ScreenUpdating = True
End Sub
Private Sub Lookups(ByVal LookupValue As Variant, ByRef Target As Range)
With Target
.Cells(1, 1).Value = Application.VLookup(LookupValue, Range("RelVenda!$A$1:$R$5000"), 6, False) 'Item
.Cells(1, 2).Value = Application.VLookup(LookupValue, Range("RelVenda!$A$1:$R$5000"), 7, False) 'Código
.Cells(1, 3).Value = Application.VLookup(LookupValue, Range("RelVenda!$A$1:$R$5000"), 8, False) 'Descrição
.Cells(1, 4).Value = Application.VLookup(LookupValue, Range("RelVenda!$A$1:$R$5000"), 9, False) 'Quantidade
.Cells(1, 5).Value = Application.VLookup(LookupValue, Range("RelVenda!$A$1:$R$5000"), 10, False) 'Unidade
.Cells(1, 6).Value = Application.VLookup(LookupValue, Range("RelVenda!$A$1:$R$5000"), 11, False) 'Preço Unitário
End With
End Sub
Sub Ordem()
ActiveWorkbook.Worksheets("PedVenda").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("PedVenda").Sort.SortFields.Add Key:=Range("E19"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("PedVenda").Sort
.SetRange Range("E19:J26")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
Postado : 19/02/2012 5:31 pm