Copy structure chart

[Martin]

Hello,

I have the following code which i think is close but not close enough. I
want to get the value from a cell in one workbook, look up that value which
will be a tab name in another workbook, find a structure chart in that sheet
and paste it back in to the sheet I started with. This is what I have:

Dim RegionName As String

RegionName = Sheets("Qry_Basic_Information").Range("A2").Value
Windows("My Pack (Structure Charts).xls").Activate
Sheets(RegionName).Select

For Each myshape In ActiveSheet.Shapes
If myshape.Type = 12 Then myshape.Copy
Next myshape

Windows("My Pack.xls").Activate
Range("B6").Select
ActiveSheet.Paste

Can anyone point me in the right direction?

Many thanks in advance,

Martin

 

[joel]

See if this works. When you paste a shape you have to paste it and then move
it to the correct location. Vecause a shape sits ontop of the worksheet you
can't just position the shape to a range location, instead you have to use
the left and top properties like below.


Dim RegionName As String
Set StructChrts = Workbooks("My Pack (Structure Charts).xls")
Set PackBk = Workbooks("My Pack.xls")

With PackBk.Sheets("Qry_Basic_Information")
RegionName = .Range("A2").Value

With StructChrts.Sheets(RegionName)

For Each myshape In .Shapes
If myshape.Type = 12 Then

myshape.Copy
.Paste
Set NewShape = Selection
NewShape.Top = Range("B6").Top
NewShape.Left = Range("B6").Left
End If
Next myshape
End With
End With

 

[Martin]

Joel, thank you, worked a treat!

Martin

See if this works. When you paste a shape you have to paste it and then move
it to the correct location. Vecause a shape sits ontop of the worksheet you
can't just position the shape to a range location, instead you have to use
the left and top properties like below.


Dim RegionName As String
Set StructChrts = Workbooks("My Pack (Structure Charts).xls")
Set PackBk = Workbooks("My Pack.xls")

With PackBk.Sheets("Qry_Basic_Information")
RegionName = .Range("A2").Value

With StructChrts.Sheets(RegionName)

For Each myshape In .Shapes
If myshape.Type = 12 Then

myshape.Copy
.Paste
Set NewShape = Selection
NewShape.Top = Range("B6").Top
NewShape.Left = Range("B6").Left
End If
Next myshape
End With
End With