Macro para Copiar Datos de un archivo a otro cuando yo lo activo

[yojoaco]

Hola expertos:
Necesito su ayuda. Estoy intentando crear una macro, pero estoy muy trabado, dada mi inexperiencia. Les cuento:

Necesito que un archivo al que yo le llamo "Control", busque los numeros que aparecen en la primer columna, en otro archivo llamado "Notas de Pedido" (tambien en la primer columna), y pegue las siguientes 7 celdas de la fila de correspondientes a cada numero de nota de pedido. Es decir, que vaya recorriendo todos los numeros, que estan en la primer columna de control y poniendole a su derecha todos los mismos valores que aparecen en "Notas de Pedido".

Les cuento que actualmente lo hago relacionando las celdas, pero el archivo me queda muy pesado y tarda mucho en abrirse, dado que tiene que actualizarse cada vez que se abre. Entonces con la macro que les pido, eliminaría la necesidad de utilizar esos vinculos.

Espero una mano, muchas gracias
Saludos
Joaquin

[mrocf]

En algún servidor gratuito "cuelga" un libro con dos hojas:

- En una hoja pon algunas varias filas de datos correspondientes al libro Control
- En la otra hoja pon algunas varias filas de datos correspondientes al libro Notas de Pedido

Y muestra como es que quieres que la información quede copiada.

Avisa cuando lo hayas hecho...
Saludos, Cacho.

[winweb89]

Hola yojoaco,

Prueba con el siguiente código. A mi me funciona.

Código:

Código vb:
Option Explicit
 
Sub Macro1()
    Dim uf1 As Long
    Dim uf2 As Long
    Dim Lista1() As Variant
    Dim Lista2() As Variant
    Dim i As Long
    Dim j As Long
    
    'Carga en 2 arrays las dos tablas (Es más rapido que consultar la hoja directamente)
    Cargar Lista("Control.xlsm", "Hoja1", "A1:H", Lista1, uf1)
    Cargar Lista("Notas de Pedido.xlsm", "Hoja1", "A1:H", Lista2, uf2)
    
    'Si el dato de la columna 1 de la tabla "Control" es igual a otro dato de la tabla "Notas de pedido"
    'copia la fila en la tabla "Control" en la posición correspondiente
    For i = 1 To uf1
        For j = 1 To uf2
            If Lista1(1, i) = Lista2(1, j) Then
                Lista1(2, i) = Lista2(2, j)
                Lista1(3, i) = Lista2(3, j)
                Lista1(4, i) = Lista2(4, j)
                Lista1(5, i) = Lista2(5, j)
                Lista1(6, i) = Lista2(6, j)
                Lista1(7, i) = Lista2(7, j)
            End If
        Next j
    Next i
    
    'Copia el array (en memoria) a la tabla de excel "Control"
    Call Volcar_Tabla("Control.xlsm", "Hoja1", Lista1)
End Sub
 
Public Function Calcular_UF(Libro As String, Hoja As String, Columna As Integer, Fila As Long) As Long
    'Calcular la ultima fila de una columna de datos
    While Not IsEmpty(Application.Workbooks(Libro).Sheets(Hoja).Cells(Fila, Columna))
        Fila = Fila + 1
    Wend
    Calcular_UF = Fila - 1
End Function
 
Public Sub Cargar_Lista(Libro As String, Hoja As String, Ran As String, list As Variant, Optional uf As Long)
    'Copia la tabla de excel a un array en memoria
    Dim Rango As Range
    Ran = Ran & Calcular_UF(Libro, Hoja, 1, 2)
    Set Rango = Application.Workbooks(Libro).Sheets(Hoja).Range(Ran)
    list = Application.Transpose(Rango)
    uf = UBound(list, 2)
End Sub
 
Private Sub Volcar_Tabla(Libro As String, Hoja As String, Tabla() As Variant)
    'Vuelca la tabla en memoria a el documento Excel
    Dim m As Long
    Dim n As Long
    Dim Rango As Range
    m = UBound(Tabla, 1)
    n = UBound(Tabla, 2)
    Set Rango = Range(Application.Workbooks(Libro).Sheets(Hoja).Cells(1, 1), Application.Workbooks(Libro).Sheets(Hoja).Cells(n, m))
    Rango = Application.Transpose(Tabla)
End Sub
 

Solo tienes que cambiar los nombres de los archivos "Control.xlsm" y "Notas de pedido.xlsm" por los nombres de tus archivos (.xlsm es de Excel 2007), puedes hacerlo con la herramienta buscar del editor de VBA. Tambien tienes que indicar el nombre de las hojas donde están los datos.

Además me parece que para que funcione tienen que estar los dos archivos Excel abiertos, si no, no funciona. Puedes incluir al principio una sentencia que abra el archivo "Notas de pedido" al ejecutarse la macro. La sintaxis la puedes ver con el grabador de macros, así es como aprendí yo.

Si en lugar de tener 2 libros, prefieres tener las dos tablas en un mismo archivo, borra las referencias a los libros asi como las variables libro.:
De: Application.Workbooks(Libro).Sheets(Hoja).Cells(Fi la, Columna)
A: Sheets(Hoja).Cells(Fila, Columna)

Si en la tabla "Hojas de pedido hay datos que se repiten en la primera columna, solo se tendrá en cuenta el último.

Salu2