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 Sub

Por favor, si me pueden ayudar, estaré muy agradecido.

1 respuesta

Respuesta
1

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 Sub

Va en un solo modulo.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas