I didn't realize that you wanted this in your loop.

But this won't do much. It just assigns the .top to the .top (no change at
all). And even worse, it's refering to the original picture.

With myPict
.Top = .Top
.Left = .Left
'myNewPict.Top = .Top
'myNewPict.Left = .Left
End With

Untested, but it did compile:

Option Explicit
Sub Generate()

Dim myCell As Range
Dim myRng As Range
Dim RngToCopy As Range
Dim DestCell As Range
Dim myPict As Picture
Dim myNewPict As Picture

Set DestCell = Worksheets.Add.Range("B2")

With Worksheets("r")
Set myRng = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
End With

With Worksheets("Z")

'this never changes, so don't do it in the loop
Set myPict = .Pictures("Picture 3")

For Each myCell In myRng.Cells

.Range("H3").Value = myCell.Value

Set RngToCopy = .Range("Branch")
RngToCopy.Copy

DestCell.PasteSpecial Paste:=xlPasteValues
DestCell.PasteSpecial Paste:=xlPasteFormats
DestCell.PasteSpecial Paste:=xlPasteColumnWidths

myPict.Copy
DestCell.Parent.Paste

'"grab" the newest picture that was pasted
With DestCell.Parent
Set myNewPict = .Pictures(.Pictures.Count)
End With

'on the first loop, m6 is 4 rows and 11 columns from B2
'should be the same relationship for the rest
With myNewPict
.Top = DestCell.Offset(4, 11).Top
.Left = DestCell.Offset(4, 11).Left
'give it a unique name
.Name = "Pict_" & DestCell.Offset(4, 11).Address(0, 0)
End With

'get ready for next time
Set DestCell = DestCell.Offset(10, 0)
Next myCell
End With

End Sub



Max wrote:

Dave, thanks for your responses.

The picture is: Picture 3 in sheet: Z
This pic floats over cell M6 which is within the range Branch to be
copied/pasted

Tried fitting in your code (shown below), but couldn't quite get it right

In the new sheet, the pic does get copy/pasted with each iteration but the
pastes are not in the correct position. The pastes all seem to be somewhere
just below the top left cell in the pasted ranges, eg C3, C13, and so on.
The correct positions should be over M6, M16, etc

------------------
Sub Generate()
Dim myCell As Range
Dim myRng As Range
Dim RngToCopy As Range
Dim DestCell As Range
Dim myPict As Picture
'Dim myNewPict As Picture

Set DestCell = Worksheets.Add.Range("B2")

With Worksheets("r")
Set myRng = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
End With

With Worksheets("Z")
For Each myCell In myRng.Cells
.Range("H3").Value = myCell.Value
Set RngToCopy = .Range("Branch")
RngToCopy.Copy

'DestCell.Select
'ActiveSheet.Paste
DestCell.PasteSpecial Paste:=xlPasteValues
DestCell.PasteSpecial Paste:=xlPasteFormats
DestCell.PasteSpecial Paste:=xlPasteColumnWidths

Set myPict = .Pictures("Picture 3")
myPict.Copy
DestCell.Parent.Paste

With myPict
.Top = .Top
.Left = .Left
'myNewPict.Top = .Top
'myNewPict.Left = .Left
End With

Set DestCell = DestCell.Offset(10, 0)
Next myCell
End With

End Sub

--

Dave Peterson