Saltar al contenido

Error 9 - Subíndice fuera de intervalo


Recommended Posts

publicado

Muy buen día, tarde, noche.

Estoy intentando realizar un proceso de selección de archivo, para copiar un determinado rango, y me lo pegue en el archivo en el que se trabaja. Para ello he desarrollado este código:


Dim Fso As Office.FileDialog
Dim LibroDestino As Workbook
Dim LibroOrigen As Workbook
Dim Ruta As String
Dim HojaDestino As Excel.Worksheet
Dim HojaOrigen As Excel.Worksheet
Dim RangoDestino As Range
Dim RangoOrigen As Range
Dim Titulo As String
Dim Balance As String
Dim UFila As Long
Dim FilaU As Long
Dim Fila As Long
Dim Final As Long

Titulo = "Administrador de proyectos AAQUINO"
Balance = ActiveSheet.Name

Application.ScreenUpdating = False
Application.DisplayAlerts = False

'On Error GoTo Errores

Set LibroDestino = ThisWorkbook
LibroDestino.Activate
Set HojaDestino = LibroDestino.Worksheets(Balance)
HojaDestino.Activate
If HojaDestino.Range("B8").Value <> "" Then
    FilaU = HojaDestino.Range("B" & Rows.Count).End(xlUp).Row
    HojaDestino.Range("A8:A" & FilaU).Select
    Selection.EntireRow.Delete
    RangoDestino.Select
End If

Set Fso = Application.FileDialog(msoFileDialogOpen)
With Fso
    .AllowMultiSelect = False
    .Title = "Seleccione el archivo de Balance (BS)"
    .Filters.Add "Archivos Excel", "*.xlsx"
    .Filters.Add "Archivos Excel 97-2003", "*.xls"
    If .Show = True Then
        Ruta = .SelectedItems(1)
    Else
        Exit Sub
    End If
End With

Set LibroOrigen = Application.Workbooks.Open(Ruta)
LibroOrigen.Activate
Set HojaOrigen = LibroOrigen.Sheets(1)
HojaOrigen.Select
Set RangoOrigen = HojaOrigen.Range("A7")
RangoOrigen.Select
UFila = HojaOrigen.Range("A" & Rows.Count).End(xlUp).Row
HojaOrigen.Range(RangoOrigen.Address & ":D" & UFila).Select
Selection.Copy

LibroDestino.Activate
HojaDestino.Select
Set RangoDestino = HojaDestino.Range("A8")
RangoDestino.PasteSpecial xlPasteValues
Application.CutCopyMode = False

LibroOrigen.Close
Set Fso = Nothing

HojaDestino.Range("A1").Select

Application.ScreenUpdating = True
Application.DisplayAlerts = True

Exit Sub

Errores:
If Err.Number <> 0 Then
    MsgBox Err.Description, vbCritical, Err.Number
    LibroOrigen.Close
    Worksheets(Balance).Select
    Exit Sub
Else
    Exit Sub
End If

End Sub

Me ha funcionado en otros proyectos, sin embargo en el que estoy tratando de hacer me está dando problemas y no doy cuál es el problema.

Me está marcando esta línea de código con el error mencionado:

Set HojaDestino = LibroDestino.Worksheets(Balance)

Me podrían ayudar a ver cuál es el motivo del error, ya le dí mil vueltas y no logro encontrar por qué me marca como error al definir la hojadestino.

También comento que el código no lo tengo dentro de un libro en sí, sino dentro del libro personal de macros, esto para que pueda ser utilizado desde cualquier libro que abra.

WP BS.xlsm

publicado

curioso a mi me marca error 91 en esta linea 

RangoDestino.Select, viendo en el panel locales me doy cuenta que RangoDestino no tiene nada y en tu programacion no esta definido que cubre esa instruccion

en la linea que te marca error a mi no me lo muestra.

error1.JPG

publicado

Perdón, este es el código correcto, pero que me está dando el error mencionado.


Dim Fso As Office.FileDialog
Dim LibroDestino As Workbook
Dim LibroOrigen As Workbook
Dim Ruta As String
Dim HojaDestino As Excel.Worksheet
Dim HojaOrigen As Excel.Worksheet
Dim RangoDestino As Range
Dim RangoOrigen As Range
Dim Titulo As String
Dim Balance As String
Dim UFila As Long
Dim FilaU As Long
Dim Fila As Long
Dim Final As Long

Titulo = "Administrador de proyectos AAQUINO"
Balance = ActiveSheet.Name

Application.ScreenUpdating = False
Application.DisplayAlerts = False

'On Error GoTo Errores

Set LibroDestino = ThisWorkbook
LibroDestino.Activate
Set HojaDestino = LibroDestino.Worksheets(Balance)
HojaDestino.Activate
If HojaDestino.Range("B8").Value <> "" Then
    FilaU = HojaDestino.Range("B" & Rows.Count).End(xlUp).Row
    HojaDestino.Range("A8:A" & FilaU).Select
    Selection.EntireRow.Delete
    HojaDestino.Range("B8").Select
End If

Set Fso = Application.FileDialog(msoFileDialogOpen)
With Fso
    .AllowMultiSelect = False
    .Title = "Seleccione el archivo de Balance (BS)"
    .Filters.Add "Archivos Excel", "*.xlsx"
    .Filters.Add "Archivos Excel 97-2003", "*.xls"
    If .Show = True Then
        Ruta = .SelectedItems(1)
    Else
        Exit Sub
    End If
End With

Set LibroOrigen = Application.Workbooks.Open(Ruta)
LibroOrigen.Activate
Set HojaOrigen = LibroOrigen.Sheets(1)
HojaOrigen.Select
Set RangoOrigen = HojaOrigen.Range("A7")
RangoOrigen.Select
UFila = HojaOrigen.Range("A" & Rows.Count).End(xlUp).Row
HojaOrigen.Range(RangoOrigen.Address & ":D" & UFila).Select
Selection.Copy

LibroDestino.Activate
HojaDestino.Select
Set RangoDestino = HojaDestino.Range("B8")
RangoDestino.PasteSpecial xlPasteValues
Application.CutCopyMode = False

LibroOrigen.Close
Set Fso = Nothing

HojaDestino.Range("A1").Select

Application.ScreenUpdating = True
Application.DisplayAlerts = True

Exit Sub

Errores:
If Err.Number <> 0 Then
    MsgBox Err.Description, vbCritical, Err.Number
    LibroOrigen.Close
    Worksheets(Balance).Select
    Exit Sub
Else
    Exit Sub
End If

Y como les mencioné, el código lo tengo en un módulo del Libro Personal de Macros.

publicado

Gracias mi estimado @Dr Hyde pero ya lo resolví... solo era de cambiar una línea

Set LibroDestino = ThisWorkbook

por

Set LibroDestino = ActiveWorkbook

Saludos, y cierren el tema por favor.

  • Silvia bloqueó este tema

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.