Esta macro No funciona en otros ordenadores

Esta Macro funciona perfectamente en mi pc, pero NO en el resto:

Que Hace: selecciona una celda del archivo principal situado en el ecritorio "Agenda.xlsm", (quedando asi establecido un rango).

Abre una carpeta en C: copia un rango de celdas del archivo "grafico.xls" de esa carpeta.

Y Pega en la Hoja Abierta( del archivo "Agenda.xlsm" donde seleccioné esa celda) en el rango establecido, el rango copiado del archivo "grafico.xls" situado en C:

En resumen es lo que hace, Pero en otros ordenadores no.

- El archivo principal "Agenda.xlsm"está situado en el escritorio (sin carpeta) el archivo solo.

-El archivo para renovar datos "grafico.xls" está en C: en una carpeta

- Problema: Cuando va a buscar la carpeta del escritorio, No la encuentra.

Os dejo la Macro, por si me podeis ayudar y funcione en el resto de escritorios de diferentes ordenadores,

Gracias por adelantado.

Saludos, Juan.

___________________________________________

Private Sub CambiarGrafico_Click()

Dim Rg As Range 'variable para poder manejar la dereccion de la celda actual
Dim R As Integer 'Necesario para recoger el valor de msgbox y no de error si tiene mas parametros
Dim ColFinal As Integer 'Para el numero de columna final
Set Rg = ActiveCell 'recoge la direccion de la celda selecionada
'Este mensaje es solo para informacion mia, se debe quitar
'R = MsgBox("Columna: " & Rg.Column & " Fila: " & Rg.Row & " Direccion: " & _
'Rg.Address(rowabsolute:=False, columnabsolute:=False) _
', vbOKOnly + vbInformation _
', "Celda seleccionada")
' range("T21").Value esto es para referenciar la celda
If Rg.Column <> 3 Then 'Yo he puesto la fecha en la columna C
R = MsgBox("Debes selecionar la fecha en la columna C", vbCritical, "Error de seleccion")
Else
'If Rg.Value > CDate("01/01/2018") Then ...esta linea del codigo original de chus
' Y esta es la que he cambiado para que coja el valor de C21
If Rg.Value > Range("C21").Value Then
R = MsgBox(" Has seleccionado esta Fecha : " & Rg.Value, vbOKCancel + vbQuestion, " Fecha de Cambio de Grafico")
If R = vbOK Then
' y desproteger hoja
ActiveSheet. Unprotect "8"
Application.ScreenUpdating = False
'selecionar el rango a copiar y pegar (para inutilizar las formulas)
'B4 (Inicio del año) O(fila de fecha del cambio) en el ejemplo
'Truco para pasar cualquier letra de columna a numero sin contar
ColFinal = Range("T1").Column
'La funcion Cells(fila, columna) referencia al contrario de Letra(columna)Numero(fila)
Range(Cells(21, 3), Cells(Rg. Row - 1, ColFinal)).Select '(B4:O(fila de fecha del cambio -1)
'pegado especial, solo valores
Selection. Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Para comprbar, ademas pongo los datos en rojo y en negrita
'Selection.Font.Color = RGB(255, 0, 0)
'Selection.Font.Bold = True
'resto de codigo para el cambio
' poner el codigo de busqueda
'volver a la celda escogida (fecha del cambio)
Rg.Select
'volver a proteger

MsgBox (" En el Rango seleccionado, solo quedarán sus Valores. Ahora se actualizará el Gráfico")
Application.CutCopyMode = False
' Pegar Nuevo Grafico
Workbooks.Open Filename:="C:\CarpetaMD\grafico.xls"
Worksheets("Hoja1").Range("A1:S1000").Copy
Workbooks.Open Filename:="Agenda.xlsm"
Range("BO16").Select
ActiveSheet.Paste
Windows("grafico.xls").Activate
'Range("A1").Select
Application.CutCopyMode = False
ActiveWindow.Close Savechanges:=False
Range("D15").Select
MsgBox " Grafico Actualizado", vbInformation, " GRÁFICO "
ActiveSheet.Protect "8"
End If
Else
R = MsgBox("la fecha del cambio debe ser mayor", vbCritical, "Error en la fecha")
End If
Application.ScreenUpdating = True
End If

End Sub

______________________________________________________________________________

Añade tu respuesta

Haz clic para o