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.
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