Sub Add_pictures()
Set CurrentWorkbook = Workbooks(ActiveWorkbook.Name)
Set InputWorksheet = CurrentWorkbook.Sheets("BASE")
Set OutputWorksheet = CurrentWorkbook.Sheets("meBOM - OTH&HH")
Dim sh As Shape
Dim i As Integer
InputWorksheet.Select

Set rng = InputWorksheet.Range(Cells(3, 1), Cells(172, 1))

For Each cell In rng
'Delete
'For Each sh In OutputWorksheet.Shapes
' If sh.TopLeftCell.Address = OutputWorksheet.Cells(cell.Row, 23).Address Then sh.Delete
'Next
For i = 1 To 172
If (cell.Value = OutputWorksheet.Cells(i, 1).Value) Then
InputWorksheet.Cells(cell.Row, 18).Copy Destination:=OutputWorksheet.Cells(i, 23)
End If
Next i
Next cell

End Sub