Another question for you.

Is it possible to add a picture at the top center of each cell that is not blank without removing its content.

I have the picture ActiveSheet.Shapes("Picture 4840").Select
Selection.Copy bit

but want to know how to add it to the cells, there are also a lot of blank cells all over the place and no two cells with content are next to each other.

Many Thanks