Picture pasting where it should but also in alot of cells it shouldn't

[DonFlak]

HELP..........

I have the following Macro:

Sub Week1()
'
' Week1 Macro
' Macro recorded 10/31/2007 by ******
'
Windows("Weather Report - SPLY.xls").Activate
Sheets("1-08").Select
Range("B3:H6").Select
Application.CutCopyMode = False
Selection.Copy
Windows("NEW-TACS-PLAN-OT.xls").Activate
Sheets("FUNC 1").Select
Range("B46").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Windows("Weather Report - SPLY.xls").Activate
Sheets("1-08").Select
Range("B8:H11").Select
Application.CutCopyMode = False
Selection.Copy
Windows("NEW-TACS-PLAN-OT.xls").Activate
Sheets("FUNC 2B").Select
Range("B46").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Windows("Weather Report - SPLY.xls").Activate
Sheets("1-08").Select
Range("B13:H16").Select
Application.CutCopyMode = False
Selection.Copy
Windows("NEW-TACS-PLAN-OT.xls").Activate
Sheets("FUNC 4").Select
Range("B46").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Windows("Weather Report - SPLY.xls").Activate
Sheets("1-08").Select
Range("B18:H21").Select
Application.CutCopyMode = False
Selection.Copy
Windows("NEW-TACS-PLAN-OT.xls").Activate
Sheets("OTHER").Select
Range("B46").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
With Workbooks("Weather Report - SPLY.xls").Sheets("1-08")
If .Range("A2").Value = "FUNCTION 1" Then
Set picSource = .Range("B1")
With Workbooks("NEW-TACS-PLAN-OT.xls")
vWorksheetNames = Array("DISTRICT ROLL-UP", "FUNC 1",
"FUNC 2B", "FUNC 4", "OTHER")
For Each vName In vWorksheetNames
With .Worksheets(vName)
picSource.Copy
.Paste
Set picDest = .Pictures(.Pictures.Count)
With .Range("B44")
picDest.Top = .Top + (.Height -
picDest.Height) / 2
picDest.Left = .Left + (.Width -
picDest.Width) / 2
End With
End With
Next vName
End With
End If
End With
'
End Sub

It does what it is supposed to do by copying and pasting all the
figures as required. It them selects the image in "B1" as it is
supposed to and Pastes it into the other workbook in cell "B44" as it
is supposed to, however it is also then pasting the same picture in
the cells beginning with range B46 where all of the figures were just
pasted and of course overwriting the data I just placed in those
cells.

I can't find what I am doing wrong.

 

[Jim Cone]

I added the destination cell for your paste operation.
I have no way of testing my change, but give it a try...
'---
With .Worksheets(vName)
picSource.Copy
.Paste .Range("B44") '<<<<<<<<<<<<<<
Set picDest = .Pictures(.Pictures.Count)
With .Range("B44")
picDest.Top = .Top + (.Height - picDest.Height) / 2
picDest.Left = .Left + (.Width - picDest.Width) / 2
End With
End With
'---
Also, four variables are not declared.
Add "Option Explicit" as the first line in your module to find out which ones.
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware
(Excel Add-ins / Excel Programming)




<[email protected]>
wrote in message
HELP..........
I have the following Macro:
-snip-
It does what it is supposed to do by copying and pasting all the
figures as required. It them selects the image in "B1" as it is
supposed to and Pastes it into the other workbook in cell "B44" as it
is supposed to, however it is also then pasting the same picture in
the cells beginning with range B46 where all of the figures were just
pasted and of course overwriting the data I just placed in those
cells.
I can't find what I am doing wrong.