Este código no corre en todas las máquina

Hola a todos, buenos días:

Tengo un programa en excel corriendo bien en la máquina en mi oficina,
pero cuando quiero correrlo en otras máquinas simplemente no corre, me
marca un error, ¿alguna sugerencia?


Option Explicit

'Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Dim Wb As Workbook
'SaveAll
'For Each Wb In Workbooks
' If Wb.Name <> ThisWorkbook.Name Then
' Wb.Close savechanges:=True
' End If
'Next Wb
'ThisWorkbook.Close savechanges:=True

'End Sub

Private Sub Workbook_Open()
Dim Ruta$, Car$, previoStatusBar$, Consulta
Car = "\"
ActiveWorkbook.Author = "Claudio Cruz"
Application.WindowState = xlMaximized
Workbooks("00 - Menu.xls").Activate
ActiveWorkbook.Sheets("Menu").Unprotect ("ed1Tm3Nu")
If ActiveWorkbook.Sheets("Sheet1").Visible = True Then
ActiveWorkbook.Sheets("Menu").Visible = True
ActiveWorkbook.Sheets("Sheet1").Visible = False
End If
ActiveWorkbook.Sheets("Menu").Activate
Range("B5").Activate
Ruta = ActiveCell.Value
Application.ScreenUpdating = False 'Deshabilitamos temporalmente
los avisos de pantalla
previoStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True ' Nos aseguramos que la barra
de estado esté visible
'Abrimos todos los archivos necesarios para la aplicación.
On Error GoTo ManejoErrores
'Proveedores
Range("B5").Activate
Ruta = ActiveCell.Value
Application.StatusBar = "Opening suppliers data..."
Workbooks.Open Filename:=Range("B5").Value & Car & "01 - SDB.xls"
Application.Windows("01 - SDB.xls").Visible = True
ActiveWorkbook.Sheets("Menu").Activate
ActiveWindow.DisplayGridlines = False
Application.Windows("01 - SDB.xls").Visible = False
'Vouchers
Application.StatusBar = "Opening vouchers module..."
Workbooks.Open Filename:=Range("B5").Value & Car & "02 -
VOUCHERS.xls"
Application.Windows("02 - VOUCHERS.xls").Visible = True
ActiveWorkbook.Sheets("1").Activate
ActiveWindow.DisplayGridlines = False
Application.Windows("02 - VOUCHERS.xls").Visible = False
'Respaldos
Application.StatusBar = "Opening backup..."
Workbooks.Open Filename:=Range("B5").Value & Car & "03 -
RESPALDOS.xls"
Application.Windows("03 - RESPALDOS.xls").Visible = True
ActiveWorkbook.Sheets("1").Unprotect Password:="pr0T3ctBackUp"
ActiveWindow.DisplayGridlines = False
ActiveWorkbook.Sheets("1").Protect Password:="pr0T3ctBackUp"
Application.Windows("03 - RESPALDOS.xls").Visible = False
'Catalogo de Cuentas
Application.StatusBar = "Opening Chart of Accounts..."
Workbooks.Open Filename:=Range("B5").Value & Car & "04A - CHART OF
ACCOUNTS.xls"
Application.Windows("04A - CHART OF ACCOUNTS.xls").Visible = True
'ActiveWorkbook.Sheets("1").Unprotect Password:="pr0T3ctBackUp"
'ActiveWindow.DisplayGridlines = False
'ActiveWorkbook.Sheets("1").Protect Password:="pr0T3ctBackUp"
Application.Windows("04A - CHART OF ACCOUNTS.xls").Visible = False
'Costos y Gastos
' Application.StatusBar = "Cargando Catálogo de Costos y Gastos..."
' Workbooks.Open Filename:=Range("B5").Value & Car & "04 - CUENTAS
COSTOS Y GASTOS.xls"
' Application.Windows("04 - CUENTAS COSTOS Y GASTOS.xls").Visible True
'ActiveWorkbook.Sheets("1").Unprotect Password:="pr0T3ctBackUp"
'ActiveWindow.DisplayGridlines = False
'ActiveWorkbook.Sheets("1").Protect Password:="pr0T3ctBackUp"
' Application.Windows("04 - CUENTAS COSTOS Y GASTOS.xls").Visible False

'Finalizando carga
Application.StatusBar = False 'Dejamos la barra de estado en
blanco
Application.DisplayStatusBar = previoStatusBar
Application.ScreenUpdating = True 'Habilitamos nuevamente los
avisos de pantalla
Workbooks("00 - Menu.xls").Activate
ActiveWorkbook.Sheets("Menu").Protect Password:="ed1Tm3Nu",
AllowFiltering:=False, _
AllowUsingPivotTables:=False
Exit Sub
ManejoErrores:
If Err.Number = 1004 Then
Application.StatusBar = False 'Dejamos la barra de estado en
blanco
Application.DisplayStatusBar = previoStatusBar
Application.ScreenUpdating = True 'Habilitamos nuevamente los
avisos de pantalla
Consulta = MsgBox("No se han encontrado los archivos." &
Chr(13) & _
"¿Desea localizar la ruta donde están guardados los
archivos?", vbExclamation + vbYesNo, "Ruta Errónea")
If Consulta = vbYes Then
ActiveWorkbook.Sheets("Menu").Unprotect ("ed1Tm3Nu")
Call getRuta
MsgBox "La ruta seleccionada es: " & Chr(13) &
Range("B5").Value & Car, vbInformation, "Ruta seleccionada"
Resume
Else
ActiveWorkbook.Sheets("Sheet1").Visible = True
ActiveWorkbook.Sheets("Menu").Visible = False
ActiveWorkbook.Sheets("Sheet1").Activate
Range("F8").Select
ActiveWindow.DisplayGridlines = False
Exit Sub
End If
End If
End Sub
Sub getRuta()
Application.GetSaveAsFilename , , , "Seleccione la ruta"
Application.Workbooks("00 - Menu.xls").Activate
ActiveWorkbook.Sheets("Menu").Activate
Range("B5").Select
With ActiveCell
.Value = CurDir
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.IndentLevel = 1
.Font.Color = RGB(128, 0, 0)
.Font.Bold = True
End With
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
Range("A1").Activate
End Sub
Public Sub CloseAll()

Dim Wb As Workbook
SaveAll
For Each Wb In Workbooks
If Wb.Name <> ThisWorkbook.Name Then
Wb.Close savechanges:=True
End If
Next Wb
ThisWorkbook.Close savechanges:=True

End Sub

Este código está en el ThisWorkbook.

De antemano, muchas gracias por la ayuda.

Claudio C.