Jump to content
  • Debido a la crisis sanitaria, hasta el día 31 de marzo, el registro al foro de Ayuda Excel será totalmente gratuito para facilitar el teletrabajo. Todos los registros que se produzcan entre estas fechas tendrán acceso gratuito ilimitado a la comunidad hasta el 30 de abril.

    Regístrate

    Si te surge alguna duda mientras estás trabajando en casa con Excel, ya tienes a quien preguntar.

    Espero que esta medida te sirva de ayuda. Frenar la expansión del coronavirus depende de todos. Sé responsable.

SALAVERRINO

Juntar archivos y extraer información especifica

Recommended Posts

Buenos tardes a los miembros de este foro, en alguna ocasión me brindaron su colaboración con la macro que adjunto, dicha macro permite seleccionar el archivo y posteriormente seleccionar la hoja con la información requerida, ahora mi consulta es, que bajo la misma lógica de la macro me permita seleccionar todos los archivos para extraer la información y sabiendo de que hoja en selección es "PLLA601", desde ya agradezco su coloración y apoyo.

Dim R
Dim a
Sub abrir()
Dim drive As String ' Unidad de Disco
Dim ruta As String 'Ruta del libro
ruta = ActiveWorkbook.Path ' Ruta actual del libro
drive = Left(ruta, 2) ' Obtengo la unidad con los dos primeros caracteres de la ruta
ChDrive drive ' ChDrive Indicamos la unidad donde está guardado tu archivo
ChDir ruta ' ChDir Indicamos el directorio declarado nteriormente
Application.ScreenUpdating = False
file = Application.GetOpenFilename
If file = False Then
Exit Sub
Else
Workbooks.OpenText Filename:=file
End If
a = ActiveWorkbook.Name
UserForm1.Show
Range("B8:AO17").Copy
'Range("B8:AO" & Range("B" & Rows. Count).End(xlup). Row). Copy 'permite copiar consolidados globales.

Windows("PLANTILLA ELECTRONICA.xlsm").Activate

n = Range("b8").Value

If n <> Empty Then
Range("b8").End(xlDown).Offset(1, 0).Select
Else
Range("b8").Select
End If
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Range("B3").Select
Range("B1").Select
Windows(a).Activate
Application.CutCopyMode = False
ActiveWindow.Close savechanges:=False
Application.ScreenUpdating = True
Copiando
End Sub
Sub Copiando()
resultado = MsgBox("Ultimo libro abierto :" & a & Chr(10) & _
"¿Desea copiar otro libro?", vbYesNo, "IMPORTANTE")
If resultado = vbYes Then
abrir
End If
End Sub
Sub Verificar()
R = Hoja1.Range("A2").End(xlUp).Row
For i = 2 To R
If Hoja2.Cells(i, 1) = "" Then
Final = i
Exit For
End If
Next
End Sub
Sub c()
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
R = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
abrir
End Sub

 

PLANTILLA ELECTRONICA.part1.rar

PLANTILLA ELECTRONICA.part2.rar

PLANTILLA ELECTRONICA.part3.rar

PLANILLA.part1.rar

PLANILLA.part2.rar

PLANILLA.part3.rar

PLANILLA.part4.rar

PLANILLA.part5.rar

PLANILLA.part6.rar

PLANILLA.part7.rar

Share this post


Link to post
Share on other sites

@SALAVERRINO , no entiendo lo de "bajo la misma lógica" :huh:

Te dejo una solución según lo que he entendido. Ahora el botón de tu libro PLANILLA te muestra un nuevo formulario.

En él tienes un listbox con todos los ficheros que tengas en el directorio, un botón para seleccionar todos los ficheros si quieres, y otro botón para importar datos.

La ryta va en el código, cámbiala por la tuya. Lógicamente la hoja por defecto a importar es "PLLA601".

Prueba y comenta:

Copia de PLANILLA

Share this post


Link to post
Share on other sites

Buenos días Haplox, la macro esta excelente y es lo que se requería obtener, solo encontré un pequeño detalle, en cuanto a la posición de los datos al ser importados, es decir su posición original debe empezar en la CELDA B8, pero como te indico al ser importados los ubica en la celda B7, eliminando 1 linea de la cabeceras que van desde la celda B5 a la B7, por lo demás todo esta bien, y como me indicaste cambie la ruta de acceso donde se encontraran los archivos a importar, ya que en la macro anterior su ubicación era de forma automática.

Desde ya agradezco su colaboración y apoyo.

Saludos.

adjunto archivo en word

 

ERROR ENCONTRADO.part1.rar

ERROR ENCONTRADO.part2.rar

ERROR ENCONTRADO.part3.rar

Share this post


Link to post
Share on other sites
Guest
This topic is now closed to further replies.



×
×
  • Create New...

Important Information

Privacy Policy


CTA Templates.png