Problemas con error al importar datos de otro libro VBA
Estoy realizando una macro para importar datos de distintos libros que voy a ir abriendo uno a uno con la macro.
Esos libros son iguales la única diferencia es que son de compañías distintas, sin embargo quiero ir consolidando todo en una sola hoja para hacer una tabla dinámica luego.
De cada libro, quiero importar 4 columnas de las hojas "Registro F-Proveedor", "Registro F-Factura", y las columnas que quiero extraer son la periodo (columna B), proveedor (columna D), cuenta (Columna AC) e importe (columna I) en ambas pestañas, sin el encabezado, ya que la pestaña hoja de destino ya los tiene.
Yo quisiera que estos datos, se pegaran en el libro "Reporte", en la pestaña "Data", a partir de la columna B, y en la columna A se llene con el nombre de la compañía que está en la hoja Menú del libro que voy a ir abriendo en la celda M2.
Yo comencé a hacer una macro para ir probando si funcionaba pero me ha dado errores en varios punto cada vez que la voy arreglando. El último error, me dio en la variable u1 cuando estoy contando las filas hasta donde voy a hacer la selección que voy a importar.
Sub LoadInfo()
Dim InfoPath As String 'donde se guada la información de la ubicacion del libro de info
Dim arr As Variant
Set h1 = Sheets("Data")
Set h2 = Sheets("Reporte")
If MsgBox("¿Desea actualizar la base de datos?", vbQuestion + vbYesNo, AddIn) = vbNo Then Exit Sub
Application.ScreenUpdating = False 'para que no se vea en pantalla la apertura del libro (tarda menos)
InfoPath = Application.GetOpenFilename 'display para abrir libro de info
Workbooks.Open Filename:=InfoPath 'abro el libro
Set h3 = Sheets("Registro F-Proveedor")
Set h4 = Sheets("Registro F-Afiliado")
Set h5 = Sheets("Base de datos")
fila = 2
u1 = h3.Range("A2" & Rows.Count).End(xlUp).Row
arr = wb.h3.Range("D" & fila & ":D" & u1 & ",AC" & fila & ":AC" & u1 & ",I" & fila & ":I" & u1)
Workbooks("Reporte").Activate
h1.Range("B" & Rows.Count).End(3)(2).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
Worksheets("Reporte").Activate 'para volver a la hoja de resultados
Application.DisplayAlerts = False 'para que no salte cuadro de diálogo de clipboard
Application.ScreenUpdating = True
End SubPor favor, si me pueden ayudar, estaré muy agradecido.
1 respuesta
Lo primero es que debes dimensionar los h1:
Dim h1 as worksheet, h2 as worksheet
Etc.
Hola, yo hice la dimensión de los h, sin embargo yo tengo una macro que no los dimensiones y me funciona. Creo que tiene que ver con la selección del archivo ya que los h1 y h2 deben ser del libro reporte y el h3, h4 y h5 del libro que vaya a abrir para importar los datos.
Prueba esto:
Sub LoadInfo()
'Siempre Dimensionar!
'insta @dj.vivanco
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim InfoPath As Variant, libroReporte As String, libroAbierto As String
Dim arrh3 As Variant, arrh4 As Variant 'un array por cada hoja a copiar
Dim ufh3 As Long, ufh4 As Long
Dim h1 As Worksheet, h2 As Worksheet, h3 As Worksheet
Dim h4 As Worksheet, h5 As Worksheet, rngMenu As Range
Set h1 = Sheets("Data")
Set h2 = Sheets("Reporte")
libroReporte = ThisWorkbook.Name
If MsgBox("¿Desea actualizar la base de datos?", vbQuestion + vbYesNo, AddIn) = vbNo Then Exit Sub
InfoPath = Application.GetOpenFilename 'display para abrir libro de info
If InfoPath = False Then Exit Sub 'linea por si presionan cancelar
Workbooks.Open Filename:=InfoPath 'abro el libro
libroAbierto = ActiveWorkbook.Name
Set rngMenu = Sheets("menu").Range("M2")
Set h3 = Sheets("Registro F-Proveedor")
Set h4 = Sheets("Registro F-Afiliado")
'Set h5 = Sheets("Base de datos") '-----------------????? falta info
ufh3 = h3.Range("b" & Rows.Count).End(xlUp).Row
ufh4 = h4.Range("b" & Rows.Count).End(xlUp).Row
arrh3 = miArray(h3, ufh3)
arrh4 = miArray(h4, ufh4)
'Me vuelvo al libro del que venía
Windows(libroReporte). Activate
'traspaso datos
TraspasarArray ufh3, arrh3, rngMenu
traspasarArray ufh4, arrh4, rngMenu
'vuelvo al libro que tenía los datos
ActiveWindow. ActivateNext
ActiveWorkbook. Close
Windows(libroReporte). Activate
End Sub
Private Function miArray(hoja As Worksheet, ultimaFila As Long) As Variant
miArray = Array(hoja.Range("b2:b" & ultimaFila).Value, hoja.Range("d2:d" & ultimaFila).Value, _
hoja.Range("i2:i" & ultimaFila).Value, hoja.Range("ac2:ac" & ultimaFila).Value)
End Function
Private Sub traspasarArray(cantFilas As Long, arrNum As Variant, rng As Range)
Dim cf As Long
cf = cantFilas - 1
With Range("b" & Rows.Count).End(xlUp)
.Offset(1, -1).Resize(cf, 1).Value = rng.Value
.Offset(1).Resize(cf, 4).Value = _
Application. Transpose(Array(Application. Transpose(arrNum(0)), Application.Transpose(arrNum(1)), _
Application.Transpose(arrNum(2)), (Application.Transpose(arrNum(3)))))
End With
End SubVa en un solo modulo.
