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"
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
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
'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