Mejorar Macro que importe datos de otro libro-excel
Feliz Navidad Para todos ustedes:
Por favor agradeceré ayudarme mejorando esta macro, es que no puedo solucionar.
La macro que pongo a continuación realiza lo siguiente
-Extrae datos de un libro que yo eligo, de una determinada hoja, en este caso de( "DETALLE MAD. ROLLIZA") y a partir de una determinada celda, en este caso de (Range("A5")).
Sin embargo lo que busco es que esta macro sea mas versatil y me de la opción de elegir la hoja (del libro previamente elegido) y el rango a partir del cual deseo que se importe los datos.
Adjunto la macro:
Sub jalaIña()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim archivo As Variant
Dim NombreHoja As String 'para la hoja
Dim hoja As Worksheet
On Error Resume Next
Sheets("HojaC").Delete
Sheets.Add
ActiveSheet.Name = "HojaC"
On Error GoTo linea
archivo = Application.GetOpenFilename(",*xls")
Workbooks.Open Filename:=archivo
Sheets("DETALLE MAD. ROLLIZA").Activate 'este es la hoja que debe tener los datos esta hoja debe ser variable al igual que el rango
Range("A5").CurrentRegion.Copy _
Destination:=Workbooks("Destino1.xlsm").Sheets("HojaC").Range("A1") 'el rango debe ser variable yo deberia elegir
ActiveWindow.Close
Sheets("HojaC").Activate
Range("A1").Activate
Application.DisplayAlerts = True
Exit Sub
linea:
Select Case Err.Number
'
Case Is = 9
MsgBox Nombre & "la Hoja DETALLE MAD. ROLLIZA no existe"
End Select
Set archivo = Nothing
End SubGracias por su apoyo y Reiterarles mi deseo de Una Feliz Navidad¡¡¡¡¡¡ y un Prospero Año Nuevo¡¡¡¡¡¡
1 Respuesta
Para más versátil la macro, se me ocurre crear un formulario, en el formulario colocas un botón para abrir el archivo y un combobox para que puedas seleccionar la hoja.
Coloca el siguiente código dentro del formulario:
Private Sub ComboBox1_Change()
'Por.Dante Amor
If ComboBox1 = "" Then Exit Sub
On Error Resume Next
Sheets(ComboBox1.Value).Select
Set rango = Application.InputBox("Selecciona el rango a copiar", _
Default:=Range("A1").Address, Type:=8)
If rango Is Nothing Then Exit Sub
Range(rango.Address).Copy Workbooks("Destino1.xlsm").Sheets("HojaC").Range("A1")
Application.DisplayAlerts = False
ActiveWindow.Close
Sheets("HojaC").Activate
Range("A1").Activate
End Sub
Private Sub ComboBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = 0
End Sub
Private Sub CommandButton1_Click()
'Por.Dante Amor
Sheets("HojaC").Cells.Clear
archivo = Application.GetOpenFilename(",*xls")
If archivo = False Then Exit Sub
Set l2 = Workbooks.Open(Filename:=archivo)
For Each h In l2.Sheets
ComboBox1.AddItem h.Name
Next
End SubInstrucciones para UserForm
- Abre tu hoja de excel
- Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
- En el menú elige Insertar / UserForm
- En el panel del UserForm creas un CommadButon
- Le das doble click al CommadButon y en el panel copias la macro
Para ejecutar la macro:
1. Abre el formulario, crea un módulo y en el módulo pon lo siguiente:
Sub abrir() UserForm1.Show End Sub
2. Ejecuta la macro abrir.
3. Cuando aparezca el formulario, presiona el botón "Abrir libro"
4. Selecciona el libro.
5. Después de que seleccionaste el libro, el combobox ya cargó las hojas contenidas en ese libro.
6. Ahora selecciona una hoja de las contenidas en el combobox.
7. Después de seleccionar la hoja, deberás seleccionar el rango, para eso te aparece una ventana llamada "Introducir", el cursor se encuentra en la celda A1 de la hoja seleccionada; presiona el botón izquierdo del mouse sobre la celda inicial de tu rango, sin soltar el botón, arrastra el mouse hasta la celda final. Ya que seleccionaste el rango presiona aceptar. La macro copiará el rango a la hojaC
No olvides valorar la respuesta.
¡Gracias! ,Dante Amor.
funciona de maravillas solo que definí la variable rango(una linea) como range,quedando el código del combo del siguiente modo
Private Sub ComboBox1_Change()
'Por.Dante Amor
If ComboBox1 = "" Then Exit Sub
On Error Resume Next
Dim rango As Range 'esto es lo que se añadio
Sheets(ComboBox1.Value).Select
Set rango = Application.InputBox("Selecciona el rango a copiar", _
Default:=Range("A1").Address, Type:=8)
If rango Is Nothing Then Exit Sub
Range(rango.Address).Copy Workbooks("Destino1.xlsm").Sheets("HojaC").Range("A1")
Application.DisplayAlerts = False
ActiveWindow.Close
Sheets("HojaC").Activate
Range("A1").Activate
End SubMil Gracias.
Un Abrazo.
Celim
