Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Excel » Juntar archivos y extraer información especifica

Excel - Juntar archivos y extraer información especifica

Volver
Nuevo Tema
<<>>
   
Vista:
Mensajes realizados anteriormente (No estaban la última vez que entraste)Juntar archivos y extraer información especifica
JOSE LUIS (11/02/2018 14:37:50)176 visitas
2 respuestas
Mensajes realizados anteriormente (No estaban la última vez que entraste)(+1)Juntar archivos y extraer información especifica
Antoni Masana (13/02/2018 08:36:53)
Mensajes realizados anteriormente (No estaban la última vez que entraste)Juntar archivos y extraer información especifica
JOSE LUIS (14/02/2018 14:44:54)
Imágen de perfil de JOSE LUIS

Juntar archivos y extraer información especifica

Publicado por JOSE LUIS (38 intervenciones) el 11/02/2018 14:37:50
Buenos días a los miembros de este foro, en esta ocasión recurro a Uds, para solicitar su apoyo y colaboración en como mejorar la macro que se encuentra en el archivo PLANTILLA ELECTRONICA.xlsm, el cual permite extraer en forma individual la información que se encuentra en la pestaña PLLA601 del archivos o archivos PLANILLA000, PLANILLA001, PLANILLA002, etc, y lo que se requiere es si mediante un list box se puede seleccionar los archivos indicados y sabiendo que información se extraera como dato unico en la pestaña PLLA601 y se valla alineando una de bajo de otra, desde ya agradezco su coloración y apoyo, adjunto codigo de la macro y los archivos y unas imagenes.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
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

Saludos.

Nota: Adjunto imagen.
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana

Juntar archivos y extraer información especifica

Publicado por Antoni Masana (809 intervenciones) el 13/02/2018 08:36:53
Antse de añadir cosas al código es mejor rectificar las que hay.

En primer lugar añadir como primera linea de código en todos los módulos esto: Option Explicit y definir todas la variables.

Aquí hay 4 eventos

- Abrir
- Copiando
- Verificar
- c

¿Son todo macros que se pueden ejecutar libremente?
¿Por que Abrir llama a Copiando y Copiando llama a Abrir? No entiendo este bucle.
El Botón de la hoja llama a Abrir ¿Para que sirve la macro C?
Y la Macro Verificar ¿Que utilidad tiene?

Un truco:

Para tener una proceso que no se vea en la lista de macros pero que será llamado por otro hay que pasarle un parámetro aunque sea ficticio:

Por ejemplo:

1
2
3
4
5
6
7
8
9
Sub Abrir()
    ...
    call Copiando ("")
    ...
End Sub
 
Sub Copiando(Nul as String)
   ...
End Sub

Ahora el proceso Copiando no sera visible desde la lista de macros.

El código arreglado visualmente

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
Option Explicit
 
Dim R
Dim a
 
' ---&--- Proceso - 1

 
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 anteriormente

 
    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
     Call Copiando
End Sub
 
' ---&--- Proceso - 2

 
Sub Copiando()
    resultado = MsgBox("Ultimo libro abierto :" & a & Chr(10) & _
    "¿Desea copiar otro libro?", vbYesNo, "IMPORTANTE")
    If resultado = vbYes Then
        Call abrir
    End If
End Sub
 
' ---&--- Proceso - 3

 
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
 
' ---&--- Proceso - 4

 
Sub c()
    Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    R = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
    Call abrir
End Sub

Por el momento ya hay bastantes cosas que revisar.

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
1
Comentar
Imágen de perfil de JOSE LUIS

Juntar archivos y extraer información especifica

Publicado por JOSE LUIS (38 intervenciones) el 14/02/2018 14:44:54
Buenos días Antoni Masana, para comentar acerca del procedimiento de la macro adjuntada:

La rutina ABRIR, como primer paso nos permite abrir un cuadro de búsqueda es decir seleccionare el archivo o archivos a procesar individualmente, una vez seleccionado el archivo, mostrara la ventana de dialogo permitiendo ubicar que pestaña deseo extraer la información para mi caso seria la pestaña PLLA601, para dar pase a la rutina COPIANDO los datos, y dentro de la rutina copiando me muestra un mensaje si deseo añadir otro archivo (rutina ABRIR) e indicando cual fue el ultimo archivo usado, ahora lo referente a la rutina VERIFICAR lo que hace es verificar que los datos extraídos hallan sido copiado correctamente y que al añadir otro archivo los copie en la fila siguiente es decir buscando que si hay una fila libre los añada.

Ahora lo que se requiere es un USERFORM con un List Box que permita mostrar el archivos o los archivos que contengan como nombre PLANILLA000.xlsm, PLANILLA001.xlsm, PLANILLA002.xlsm, etc y extraiga la información la ventana PLLA601, que todos estos archivos contiene y sean importados al archivo PLANTILLA ELECTRONICA.xlsm una tras otra, respetando el orden de cada archivo.

Espero haber aclarado un poco lo solicitado, esperando su colaboración y apoyo.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Revisar política de publicidad