Exportar de Excel a Excel

Enviar datos de un libro de Excel a otro:
Sub CeldaDeExcelExcel()
    Dim Libro1 As Workbook
    Dim Libro2 As Workbook
    Dim DirLibro1 As String
    Dim DirLibro2 As String
    
    'Desactivamos las alertas
    Application.DisplayAlerts = False
    
    'Indicamos la ubicación de los Libros 1 y 2
    DirLibro1 = "D:\Pruebas\Libro 1.xlsx"
    DirLibro2 = "D:\Pruebas\Libro 2.xlsx"

    'Abrimos los Libros 1 y 2
    Set Libro1 = Workbooks.Open(DirLibro1)
    Set Libro2 = Workbooks.Open(DirLibro2)
    
    'Copiamos un valor de celda del Libro 1 al Libro 2
    Libro2.Sheets("Celda destino").Cells(3, 3).Value = Libro1.Sheets("Celda Origen").Cells(2, 2).Value
    Libro2.Sheets("Celda destino").Range("C5").Value = Libro1.Sheets("Celda Origen").Range("Valor2").Value
        
    'Cerramos el Libro 1 sin guardar cambios
    Libro1.Close False

    'Cerramos el Libro 2 guardando los cambios
    Libro2.Close True
    
    'Liberamos memoria
    Set Libro1 = Nothing
    Set Libro2 = Nothing
    
    'Activamos nuevamente las alertas
    Application.DisplayAlerts = True
End Sub

Ejemplo para pasar fórmula de una celda de un libro a otro:
Sub FormulaDeExcelExcel()
    Dim Libro1 As Workbook
    Dim Libro2 As Workbook
    Dim DirLibro1 As String
    Dim DirLibro2 As String
    
    'Desactivamos las alertas
    Application.DisplayAlerts = False
    
    'Indicamos la ubicación de los Libros 1 y 2
    DirLibro1 = "D:\Pruebas\Libro 1.xlsx"
    DirLibro2 = "D:\Pruebas\Libro 2.xlsx"

    'Abrimos los Libros 1 y 2
    Set Libro1 = Workbooks.Open(DirLibro1)
    Set Libro2 = Workbooks.Open(DirLibro2)
    
    'Copiamos las fórmulas de celdas del Libro 1 al Libro 2
    Libro2.Sheets("Celda destino (F)").Cells(3, 3).Formula = Libro1.Sheets("Celda Origen (F)").Cells(2, 2).Formula
    Libro2.Sheets("Celda destino (F)").Range("C5").Formula = Libro1.Sheets("Celda Origen (F)").Range("Valor2F").Formula
        
    'Cerramos el Libro 1 sin guardar cambios
    Libro1.Close False

    'Cerramos el Libro 2 guardando los cambios
    Libro2.Close True

    'Liberamos memoria
    Set Libro1 = Nothing
    Set Libro2 = Nothing
    
    'Activamos nuevamente las alertas
    Application.DisplayAlerts = True
End Sub

Ejemplo para pasar un rango de un libro a otro:
Sub RangoDeExcelExcel()
    Dim Libro1 As Workbook
    Dim Libro2 As Workbook
    Dim DirLibro1 As String
    Dim DirLibro2 As String
    
    'Desactivamos las alertas
    Application.DisplayAlerts = False
    
    'Indicamos la ubicación de los Libros 1 y 2
    DirLibro1 = "D:\Pruebas\Libro 1.xlsx"
    DirLibro2 = "D:\Pruebas\Libro 2.xlsx"

    'Abrimos los Libros 1 y 2
    Set Libro1 = Workbooks.Open(DirLibro1)
    Set Libro2 = Workbooks.Open(DirLibro2)
    
    'Copiamos un rango del Libro 1 al Libro 2
    Libro1.Sheets("Rango Origen").Range("RangoOrigen").Copy
    Libro2.Sheets("Rango Destino").Range("RangoDestino").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    'Cerramos el Libro 1 sin guardar cambios
    Libro1.Close False

    'Cerramos el Libro 2 guardando los cambios
    Libro2.Close True

    'Liberamos memoria
    Set Libro1 = Nothing
    Set Libro2 = Nothing
    
    'Activamos nuevamente las alertas
     Application.DisplayAlerts = True
End Sub


Ejemplo para pegar un gráfico de un libro a otro:
Sub GraficoDeExcelExcel()
    Dim Libro1 As Workbook
    Dim Libro2 As Workbook
    Dim DirLibro1 As String
    Dim DirLibro2 As String
    
    'Desactivamos las alertas
    Application.DisplayAlerts = False
    
    'Indicamos la ubicación de los Libros 1 y 2
    DirLibro1 = "D:\Pruebas\Libro 1.xlsx"
    DirLibro2 = "D:\Pruebas\Libro 2.xlsx"

    'Abrimos los Libros 1 y 2
    Set Libro1 = Workbooks.Open(DirLibro1)
    Set Libro2 = Workbooks.Open(DirLibro2)
    
    'Copiamos un gráfico del Libro 1 al Libro 2
    Libro1.Sheets("Gráfico Origen").ChartObjects(1).Copy
    Libro2.Sheets("Gráfico Destino").Activate
    Range("A1").Select
    ActiveSheet.Paste   ' Pegar vínculado al Libro 1
    'ActiveSheet.Pictures.Paste   ' Pegar como imagen
        
    'Cerramos el Libro 1 sin guardar cambios
    Libro1.Close False

    'Cerramos el Libro 2 guardando los cambios
    Libro2.Close True

    'Liberamos memoria
    Set Libro1 = Nothing
    Set Libro2 = Nothing
    
    'Activamos nuevamente las alertas
    Application.DisplayAlerts = True
End Sub

Ejemplo para pegar una consulta SQL de un libro a otro:
'NOTA: Marcar referencia (Herramienta -> Referencias...)
'           "Microsoft ActiveX Data Object 2.8 Library"
Sub PegarConsultaSQL_LibroExcel()
    'En caso de error ir a "err"
    On Error GoTo err

    'Declaración de variables
    Dim cn As ADODB.Connection  'Objeto de conexión
    Dim rst As ADODB.Recordset  'Objeto de recorset
    Dim sql As String           'Sentencia SQL
    Dim RutaBD As String        'Ruta de la tabla Excel
    Dim ArchivoBD As String     'Nombre del archivo Excel que contiene la tabla
    Dim i As Integer            'Contador
    Dim Libro2 As Workbook
    Dim DirLibro2 As String

    'Desactivamos las alertas
    Application.DisplayAlerts = False

    'Consulta SQL
    sql = "SELECT * FROM [Volumen$] WHERE Evento = 'MVFA 2017'“

    'Crea un objeto Conexión
    Set cn = CreateObject("ADODB.Connection")
    
    'IMPORTANTE: Indicar la cadena de conexión a usar
    RutaBD = "D:\Pruebas"
    ArchivoBD = "Libro 1.xlsx"

    cn.ConnectionString = "ODBC;DBQ=" & RutaBD & "\" & ArchivoBD & ";DefaultDir=" & _
        RutaBD & ";Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & _
        "DriverId=1046;FIL=excel 12.0;MaxBufferSize=2048;MaxScanRows=8;" & _
        "PageTimeout=5;ReadOnly=1;SafeTransactions=0;Threads=3;UID=admin;UserCommitSync=Yes;"

    'Abre la conexión a la base de datos
    cn.Open

    'Crea un nuevo objeto recordset
    Set rst = CreateObject("ADODB.Recordset")

    'Ejecuta la sentencia SQL para llenar el recordset
    rst.Open sql, cn

    'Indicamos la ubicación del Libro 2
    DirLibro2 = "D:\Pruebas\Libro 2.xlsx“

    'Abrimos el Libro 2
    Set Libro2 = Workbooks.Open(DirLibro2)

    'Pegamos el resultado de la consulta SQL
    Libro2.Sheets("SQL").Range("A2").CopyFromRecordset rst

    'Cerramos el Libro 2 guardando los cambios
    Libro2.Close True

    'Cierra y descarga las referencias
    On Error Resume Next

    'Cerramos variables de conexión con BD y liberamos memoria
    rst.Close
    cn.Close

    'Liberamos memoria
    Set rst = Nothing
    Set cn = Nothing
    Set Libro2 = Nothing
err:
    'Activamos nuevamente las alertas
    Application.DisplayAlerts = True
End Sub


No hay comentarios:

Publicar un comentario