Transferir datos desde un libro a otro, actualizando cada vez que se haga la transferencia

Tengo dos libros excel uno llamado "Ingreso y Egreso" y el otro "Correlativo". En ambos libros tengo una hoja llamada "Base de datos". Lo que necesito es que apretando un botón de un formulario desde el libro "Ingreso y Egreso", se abra el libro "Correlativo"y a su ves se transfiera el contenido de la hoja de base de datos.

Este es el formulario

Por lo tanto al apretar correlativo se debe abrir ese libro y transferir los datos de una base de datos a otra.

1 respuesta

Respuesta
1

H ol a: En un correo nuevo envíame tu archivo con el formulario; y me explicas qué datos hay que pasar, exactamente de qué hoja, qué celdas; y dónde se va a poner, en cuál hoja y en cuáles celdas.

Te anexo la macro

Private Sub btnCorrelativo_Click()
    Set archivo = CreateObject("Scripting.filesystemObject")
    nombre_archivo = "\\NT_METRO\Metro_Shared1\Gerencia_de_Mantenimiento\Metrología\CORRELATIVO.xlsm"
    'nombre_archivo = ThisWorkbook.Path & "\CORRELATIVO.xlsm"
    If archivo.FileExists(nombre_archivo) Then
        Set l1 = ThisWorkbook
        Set h1 = l1.Sheets("BASE DE DATOS")
        Set l2 = Workbooks.Open(nombre_archivo)
        Set h2 = l2.Sheets("BASE DE DATOS")
        u1 = h1.Range("B" & Rows.Count).End(xlUp).Row
        u2 = h2.Range("B" & Rows.Count).End(xlUp).Row + 1
        h1.Range("A5:E" & u1).Copy
        h2.Range("A" & u2).PasteSpecial xlValues
        'End
        MsgBox "Datos traspasados"
    Else
        MsgBox "El archivo no existe"
    End If
    Set archivo = Nothing
End Sub

Prueba y me comentas

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

Macro actualizada

Private Sub btnCorrelativo_Click()
    Set archivo = CreateObject("Scripting.filesystemObject")
    nombre_archivo = "\\NT_METRO\Metro_Shared1\Gerencia_de_Mantenimiento\Metrología\CORRELATIVO.xlsm"
    'nombre_archivo = ThisWorkbook.Path & "\CORRELATIVO.xlsm"
    If archivo.FileExists(nombre_archivo) Then
        Application.ScreenUpdating = False
        Set l1 = ThisWorkbook
        Set h1 = l1.Sheets("BASE DE DATOS")
        Set l2 = Workbooks.Open(nombre_archivo)
        Set h2 = l2.Sheets("BASE DE DATOS")
        'u1 = h1.Range("B" & Rows.Count).End(xlUp).Row
        'u2 = h2.Range("B" & Rows.Count).End(xlUp).Row + 1
        h1.Range("A:E").Copy
        h2.Range("A1").PasteSpecial xlValues
        'End
        Application.ScreenUpdating = True
        MsgBox "Datos traspasados"
    Else
        MsgBox "El archivo no existe"
    End If
    Set archivo = Nothing
End Sub

R ecuerda cambiar la valoración de la respuesta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas