Maybe:
![]()
Sub Witebutter() Dim lr As Long Dim rcell As Range Application.ScreenUpdating = False lr = Cells(Rows.Count, 1).End(xlUp).Row 'On sheet1 Columns("C:C").Insert SHIFT:=xlToRight With Range("D2:D" & lr) .Formula = "=VLOOKUP(C2,Sheet2!$C$2:$C$1000,1,FALSE)" .Value = .Value .Replace What:="#N/A", Replacement:="", LookAt:=xlWhole End With Columns("F:F").Insert SHIFT:=xlToRight With Range("F2:F" & lr) .Formula = "=VLOOKUP(E2,Sheet2!$D$2:$D$1000,1,FALSE)" .Value = .Value .Replace What:="#N/A", Replacement:="", LookAt:=xlWhole End With For Each rcell In Range("D2:D" & lr) If rcell.Value <> "" Then If rcell.Offset(, 2) <> "" Then rcell.EntireRow.Copy Sheets("Sheet3").Range("A" & Rows.Count).End(3)(2) End If End If Next rcell Application.ScreenUpdating = True End Sub











LinkBack URL
About LinkBacks
Register To Reply

Bookmarks