Ayuda con importación de datos excel a excel ...!

Buen día espero me puedan apoyar necesito generar una macro para importar datos desde otro libro cabe mencionar que deseo importar datos de diferentes libros, pero siempre los mismos rangos por lo que necesito seleccionar el libro y extraer esos rangos solo del libro seleccionado, espero haberme dado a entender anexo lo que llevo:

Sub importar_fichero()

Application.ScreenUpdating = False

Dim strRutaArchivo As String
strRutaArchivo = _
Application.GetOpenFilename("Libro de Microsoft Excel (*.xlsx), *.xlsx")
Workbooks.Open Filename:=strRutaArchivo


ruta = ThisWorkbook.Path
fichero = strRutaArchivo
Set Conn = New ADODB.Connection
Conn.Open "DRIVER={Microsoft Excel Driver (*.xls)};DBQ=" & ruta & "\" & fichero
Set rs = New ADODB.Recordset
Sql = "SELECT * FROM A1:C7"
rs.Open Sql, Conn, adOpenStatic, adLockOptimistic
Range("A1").Select
ActiveCell = rs.Fields.Item(0).Name
ActiveCell.Offset(0, 1) = rs.Fields.Item(1).Name
ActiveCell.Offset(0, 2) = rs.Fields.Item(2).Name
Range("A1:C1").Font.Bold = True
Do While Not rs.EOF
ActiveCell.Offset(1, 0) = rs(0)
ActiveCell.Offset(1, 1) = rs(1)
ActiveCell.Offset(1, 2) = rs(2)
rs.MoveNext
ActiveCell.Offset(1, 0).Select
Loop
rs.Close
Conn.Close
Set rs = Nothing
Set Conn = Nothing
Application.ScreenUpdating = True


End Sub

Espero me puedan ayudar...

SALUDOS

0

Añade tu respuesta

Haz clic para o