The reason why your code is deleting all pictures is because the code refers to the ActiveSheet.
For Each shp In ActiveSheet.Shapes
If shp.Name <> "Picture2" Then shp.Delete
Try this (deletes all pictures in the range C1:C50):
HTHCode:Sub Test() Dim Sh As Shape With Worksheets("Sheet1") For Each Sh In .Shapes If Not Application.Intersect(Sh.TopLeftCell, .Range("C1:C50")) Is Nothing Then If Sh.Type = msoPicture Then Sh.Delete End If Next Sh End With End Sub