Excel Pega graficos no deseados

hola, Hector !

... he estado trabajando un archivo a traves de unas macros en la que
recorro las hojas de mi "archivo origen" y copio una grafica (como imagen)
que se encuentra en cada hoja y luego la pego en mi "archivo destino".

1) revisa (la fraccion d)el codigo que expones, porque en el bucle (for x = 1 to 10)
NO estas "recorriendo las hojas del archivo de origen"
solo recorres las hojas en el archivo "de destino" (?)

Mi problema es que Excel copia la grafica de la hoja que corresponde
pero cuando pega en el archivo destino, pega todas las graficas que ya ha copiado en el bucle.
... de 10 repeticiones, en la hoja 1 me pega 1 grafica (la 1), en la hoja 2 me pega dos graficas (1 y 2)
en la 3, pega 3 graficas (1,2,3) así sucesivamente.
He intentado usando "Application.CutCopyMode = False" luego de cada repeticion, pero siempre pega las otras graficas.
Tambien intente forzar el vaciado del portapapeles y aun asi no me funciono.
No se si alguien me pueda colaborar a solucionar este problema.

2) no conozco de alguna forma en que el portapapeles "acumule" varias acciones de "copiar" SIN sustituir las anteriores (?)
prueba agregando una linea de "copiado" JUSTO ANTES del ".cutcopymode = false" (pero) copiando primero alguna celda vacia (p.e.)

de:
Application.CutCopyMode = False

a:
Range("iv65536").Copy
Application.CutCopyMode = False

saludos,
hector.

__ el codigo expuesto (fraccion) __
For x = 1 to 10
sheets(x).select
Windows("ArchivoOrigen.xls").Activate
ActiveSheet.ChartObjects("ChartShare").Activate
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
Windows("ArchivoDestino").Activate
Range("C48").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Next x

Gracias tocayo por responder,

1) revisa (la fraccion d)el codigo que expones, porque en el bucle (for x = 1 to 10)
NO estas "recorriendo las hojas del archivo de origen"
solo recorres las hojas en el archivo "de destino" (?)

En efecto tienes razón, me equivoqué cuando traslade el codigo, ya que
quise "pegar" unicamente la parte que considere era de mayor
relevancia, pero en todo caso abajo pongo el codigo completo del
procedimiento.

2) no conozco de alguna forma en que el portapapeles "acumule" varias acciones de "copiar" SIN sustituir las anteriores (?)
prueba agregando una linea de "copiado" JUSTO ANTES del ".cutcopymode = false" (pero) copiando primero alguna celda vacia (p.e.)

de:
Application.CutCopyMode = False

a:
Range("iv65536").Copy
Application.CutCopyMode = False

La verdad a mi me parece muy extraño este resultado tambien, ya que
tengo un codigo similar para otro archivo, y no me da ningun
problema. No se si ahora que coloco el codigo completo, talvez sea
más facil encontrar algun "defecto" en el mismo. Pero la verdad es que
si me pega las imagenes exactamente una abajo de la otra.

Mil gracias de antemano por el apoyo.

Saludos,


Sub GenerarReportes()

Application.ScreenUpdating = False
Application.EnableEvents = False

Dim Direccion, Pais, x

Direccion = Application.ActiveWorkbook.Path

Workbooks.Add (Direccion & "\Template.xlt")

Archivo = "Reporte Semanal" & Format(Now(), " ddmmmyy") & " " &
Format(Now(), "hhmm") & ".xls"
ActiveWorkbook.SaveAs (Direccion & "\" & Archivo)

Windows("Generador Mensual.xls").Activate
Sheets("Export").Select
Cantidad = Cells(1, 3).Value
Cells(1, 2).Select
x = 0
Application.Calculation = xlCalculationManual

Do While ActiveCell.Value <> "Fin"

x = x + 1
'For x = 1 To 6
If x > 1 Then
Windows(Archivo).Activate
Sheets(x - 1).Copy After:=Sheets(x - 1)
End If

Windows("Generador Mensual.xls").Activate

Pais = ActiveCell.Value

Sheets(Pais).Select
Sheets(Pais).Activate

Range("J2:J5").Select
Selection.Copy
Windows(Archivo).Activate
Sheets(x).Select
Range("J2").Select
PasteValores
Application.CutCopyMode = False
ActiveSheet.Name = Pais

Windows("Generador Mensual.xls").Activate
Range("D13:AO28").Select
Selection.Copy
Windows(Archivo).Activate
Range("D13").Select
PasteValores
Application.CutCopyMode = False

Windows("Generador Mensual.xls").Activate
Range("F11:AO11").Select
Selection.Copy
Windows(Archivo).Activate
Range("F11").Select
PasteValores
Application.CutCopyMode = False

Windows("Generador Mensual.xls").Activate
Range("D31:Q46").Select
Selection.Copy
Windows(Archivo).Activate
Range("D31:Q46").Select
PasteValores
Application.CutCopyMode = False


Windows("Generador Mensual.xls").Activate
Sheets(Pais).Select
ActiveSheet.ChartObjects("ChartShare").Activate
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen,
Format:=xlPicture
Windows(Archivo).Activate
Sheets(x).Select
Range("C48").Select
ActiveSheet.Paste
Selection.ShapeRange.Top = 646
Selection.ShapeRange.Left = 4
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Width = 1025
Application.CutCopyMode = False


Windows("Generador Mensual.xls").Activate
Range("AF31:AO46").Select
Selection.Copy
Windows(Archivo).Activate
Range("AF31:AO46").Select
PasteValores
Application.CutCopyMode = False

Windows("Generador Mensual.xls").Activate
encabezado = Range("C13").Value
Windows(Archivo).Activate
Range("C13").Value = encabezado

Windows("Generador Mensual.xls").Activate
encabezado = Range("C19").Value
Windows(Archivo).Activate
Range("C19").Value = encabezado

Windows("Generador Mensual.xls").Activate
encabezado = Range("C31").Value
Windows(Archivo).Activate
Range("C31").Value = encabezado

Windows("Generador Mensual.xls").Activate
encabezado = Range("C37").Value
Windows(Archivo).Activate
Range("C37").Value = encabezado

Range("A1").Select
Application.CutCopyMode = False

Windows("Generador Mensual.xls").Activate
'Range("A1").Select
Sheets("Export").Select

UserForm2.ProgressBar1.Value = ((100 / Cantidad) * x) - 1
ActiveCell.Offset(1, 0).Select

Loop

'Next x
Windows("Generador Mensual.xls").Activate
Sheets(1).Select
Range("A1").Select

Windows(Archivo).Close Savechanges:=True

Sheets(1).Select

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlAutomatic

UserForm2.Hide

MsgBox ("Archivo generado correctamente!") & _
Chr(13) & ("Nombre de archivo: " & Archivo) & _
Chr(13) & ("Path: " & Direccion), vbOKOnly

End Sub

Sub PasteValores()
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
End Sub

hola, tocayo !

... tengo un codigo similar para otro archivo, y no me da ningun problema.
No se si ahora que coloco el codigo completo, talvez sea mas facil encontrar algun "defecto" en el mismo.
Pero la verdad es que si me pega las imagenes exactamente una abajo de la otra...

la "duplicacion" de los objetos incrustados esta al principio del bucle (en el codigo que expones)...
en esta parte == Do While ActiveCell.Value <> "Fin"
x = x + 1
If x > 1 Then
Windows(Archivo).Activate
Sheets(x - 1).Copy After:=Sheets(x - 1)
End If
[... ... ...]
y a partir de la hoja 2 ==
las "siguientes" hojas (cuando x > 1 Then ...) ya llevan las graficas de las hojas anteriores MAS la que les toca :-((

saludos,
hector.

Hola tocayo,

Error de novato! Como siempre tienes toda la razón.
Mil gracias por tu ayuda.

Saludos,