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.
Respuesta de Dante Amor
1
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 SubPrueba 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 SubR ecuerda cambiar la valoración de la respuesta.
