Macro para copiar datos de un libro a otro

Estoy intentando montar una macro que me permita, desde el libro1 en el que la ejecuto, abrir otro libro2, seleccionar un rango de datos, copiarlo y pegarlo en el libro1.

Mi conocimiento de visual basic es limitadísimo, así que buscando por ahí encontré una macro muy elegante, a mi entender, con la que ni siquiera hay que abrir el libro2 para copiar los datos. La macro es esta:

Sub macro_copiar_pegar()
Dim strArchivo As String, strSQL As String
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim arrData As Variant

strArchivo = ThisWorkbook.Path & "\archivo2.xls"

'Comprobamos si el archivo existe en la ruta indicada
If Dir(strArchivo) = "" Then
MsgBox "No existe el archivo en la ruta indicada."
Exit Sub
End If

'Creamos la cadena texto de la consulta SQL
strSQL = "Select * From [Hoja1$A2]"

'Creamos la conexión al archivo
Set cn = New ADODB.Connection
cn.Open "DRIVER={Microsoft Excel Driver (*.xls)};" & _
"DriverIdy0;ReadOnly=True;DBQ=" & strArchivo & ";"

'Extraemos los datos
Set rs = New ADODB.Recordset
Rs.Open strSQL, cn, adOpenForwardOnly, _
AdLockReadOnly, adCmdText

'Copiamos los datos en la celda destino
Workbooks("libro1.xlsm").Worksheets("Hoja1") _
. Range("C3"). CopyFromRecordset rs

'Cerramos la conexión y vaciamos las variables
rs. Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub

El autor de la macro decía que "El código requiere una referencia a la librería "Microsoft ActiveX Data Objects #.# Library" (donde #.# es el numero de la
versión mas moderna disponible)". Así que active la referencia Microsoft ActiveX Data Objects 2.8 Library, que parece ser la versión más moderna que tengo.

Cuando ejecuto la macro por pasos me sale un error en el apartado 'Extraemos los datos, concretamente en las líneas:

Rs.Open strSQL, cn, adOpenForwardOnly, _
AdLockReadOnly, adCmdText

El error dice:

[Microsoft][Controlador ODBC Excel]El motor de base de datos Microsoft Jet no puedo encontrar el objeto 'Hoja1$A2'. Asegúrese de que el objeto existe, y que ha escrito el nombre y la ruta de acceso al objeto correctamente.

¿Alguien podría ayudarme a "arreglar" el código?

1

1 Respuesta

No entiendo la mayor parte del código, jjj... pero espero te sirva este... que creo esta un poco mas resumido...

Cualquier pregunta me la haces llegar...

Sub CopiarDeOtroLibro()
Dim Lib1, Lib2 As Workbook
Dim STR1 As String
STR1 = Application.GetOpenFilename("Libro de Excel, *.xlsm*", , "Informe")
If STR1 = CStr(False) Then Exit Sub
Set Lib1 = ThisWorkbook
Set Lib2 = Workbooks.Open(STR1)
Lib2. Range("A1:A200"). Copy
Lib1. Activate
Lib1. Range("A1"). Activate
ActiveSheet. Paste
Lib2. Close
Set Lib1 = Nothing
Set Lib2 = Nothing
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas