Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Excel » abrir archivos distintos,extraer datos, cerrar archivos

Excel - abrir archivos distintos,extraer datos, cerrar archivos

Volver
Nuevo Tema
<<>>
 
Vista:
sin imagen de perfil

abrir archivos distintos,extraer datos, cerrar archivos

Publicado por Oscar Ordenes (3 intervenciones) el 10/05/2017 19:22:41
Buenas tardes a todos, no soy un experto en VBA y trato de hacer lo mejor que puedo, en este caso tengo el sgte problema.
Tengo 30 archivos diferentes por fecha para un local y son 50 locales con nombres distintos. Debo extraer de cada achivo información que aparece en ellas. Hice una macro que efectivamente extrae el dato y lo copia a un archivo base, el problema es que al copiar n veces esta forma de extraer el dato me arroja un error de compilación, procedimiento demasiado largo. Adjunto macro que hice para un local.
Los nombres de los archivos varían por número de local y fecha, a la macro debo estar cambiando la fecha y local. También señalo que los archivos estan en carpetas distintas CarpetaF86 30 archivos Carpeta F90 30 archivos, así en adelante

01052017F86.xls
01052017F90.xls
01052017F107.xls

01052017F86.xls
02052017F86.xls
03052017F86.xls

Esta es la macro

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
Sub BD()
 
sw1 = 4
sw2 = 6
fec = 3
a = 2
 
 
 Workbooks.Open Filename:= _
        "G:\Department\Contraloria\Operacion Directa\F86\RCT\2017\MAYO\07052017F86.xls"
    Sheets("Faltantes Combustible").Select
 
 
 
    Do While Workbooks("07052017F86.xls").Worksheets("Faltantes Combustible").Cells(sw2, 1) <> ""
        Do While Workbooks("07052017F86.xls").Worksheets("Faltantes Combustible").Cells(5, fec) <> "Total Mes"
            If Workbooks("07052017F86.xls").Worksheets("Faltantes Combustible").Cells(sw2, fec) <> "" Then
                Workbooks("Status_Faltantes_Mayo2017.xlsm").Worksheets("Descuentos_Mayo").Cells(a, 6) = Workbooks("07052017F86.xls").Worksheets("Faltantes Combustible").Cells(5, fec) 'Fecha

                Workbooks("Status_Faltantes_Mayo2017.xlsm").Worksheets("Descuentos_Mayo").Cells(a, 9) = Workbooks("07052017F86.xls").Worksheets("Faltantes Combustible").Cells(sw2, 2) 'Rut

                Workbooks("Status_Faltantes_Mayo2017.xlsm").Worksheets("Descuentos_Mayo").Cells(a, 12) = Workbooks("07052017F86.xls").Worksheets("Faltantes Combustible").Cells(sw2, fec) 'Monto

                a = a + 1
                fec = fec + 1
            Else
            fec = fec + 1
            End If
 
        Loop
        sw2 = sw2 + 1
        fec = 3
    Loop
 
    Workbooks("07052017F86.xls").Activate
    Sheets("Faltantes Tienda").Select
 
    sw2 = 6
    Do While Workbooks("07052017F86.xls").Worksheets("Faltantes Tienda").Cells(sw2, 1) <> ""
        Do While Workbooks("07052017F86.xls").Worksheets("Faltantes Tienda").Cells(5, fec) <> "Total Mes"
            If Workbooks("07052017F86.xls").Worksheets("Faltantes Tienda").Cells(sw2, fec) <> "" Then
                Workbooks("Status_Faltantes_Mayo2017.xlsm").Worksheets("Descuentos_Mayo").Cells(a, 6) = Workbooks("07052017F86.xls").Worksheets("Faltantes Tienda").Cells(5, fec) 'Fecha

                Workbooks("Status_Faltantes_Mayo2017.xlsm").Worksheets("Descuentos_Mayo").Cells(a, 9) = Workbooks("07052017F86.xls").Worksheets("Faltantes Tienda").Cells(sw2, 2) 'Rut

                Workbooks("Status_Faltantes_Mayo2017.xlsm").Worksheets("Descuentos_Mayo").Cells(a, 12) = Workbooks("07052017F86.xls").Worksheets("Faltantes Tienda").Cells(sw2, fec) 'Monto

                a = a + 1
                fec = fec + 1
            Else
            fec = fec + 1
            End If
 
        Loop
        sw2 = sw2 + 1
        fec = 3
    Loop
    'ActiveWorkbook.Close Savechanges:=False

    Workbooks("07052017F86.xls").Close Savechanges:=False
 MsgBox ("Fin Proceso......")
End Sub
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

abrir archivos distintos,extraer datos, cerrar archivos

Publicado por JuanC (1237 intervenciones) el 10/05/2017 22:28:44
sólo un consejo: declarar variables con su tipo...

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Dim a&, fec&, sw1&, sw2&, ws1 As Worksheet, ws2 As Worksheet
 
Set ws1 = Workbooks("07052017F86.xls").Worksheets("Faltantes Combustible")
Set ws2 = Workbooks("Status_Faltantes_Mayo2017.xlsm").Worksheets("Descuentos_Mayo")
 
Do While ws1.Cells(sw2, 1) <> ""
   Do While ws1.Cells(5, fec) <> "Total Mes"
      If ws1.Cells(sw2, fec) <> "" Then
         ws2.Cells(a, 6) = ws1.Cells(5, fec) 'Fecha

         ws2.Cells(a, 9) = ws1.Cells(sw2, 2) 'Rut

         ws2.Cells(a, 12) = ws1.Cells(sw2, fec) 'Monto

         a = a + 1
         fec = fec + 1
      Else
           fec = fec + 1
      End If
   Loop
   sw2 = sw2 + 1
   fec = 3
Loop
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
sin imagen de perfil

abrir archivos distintos,extraer datos, cerrar archivos

Publicado por Oscar Rodrigo (3 intervenciones) el 12/05/2017 03:08:47
Buenas Noches, disculpa no contestar antes...

He logrado que la macro realice el ejercicio de Ir al directorio, C:\Users\Oscar.Ordenes\Desktop\Resumen RCT\Mayo\F086\RCT\2017\MAYO
En la carpeta MAYO se encuentran los archivos que correponden al local F86. ejemp 01052017F86.xls, 02052017F86.xls en estos archivos hay 2 hojas de las que extraigo información (Faltantes Combustibles y Faltantes Tiendas. Por lo menos reduje un poco la macro pero esta solo lo hace para un Local y son 50.
En la ruta debiera tener la posibilidad de ir cambiando la subcarpeta F086 a F090, F091, F092 y así con todas las demás para seguir leyendo los archivos que se encuentran ahí. Envío un par de archivos y el archivo gral. y la macro actual.

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
Sub BD()
'1 File F86

 
 
sw1 = 4
sw2 = 6
fec = 3
a = 2
 
Dim Archivos As String
Dim RutaCarpF86 As String
 
RutaCarpF86 = "C:\Users\Oscar.Ordenes\Desktop\Resumen RCT\Mayo\F086\RCT\2017\MAYO\"
 
Archivos = Dir(RutaCarpF86)
 
Do While Archivos <> ""
 Workbooks.Open Filename:=(RutaCarpF86 & Archivos)
 Sheets("Faltantes Combustible").Select
 
 
 
    Do While Workbooks(Archivos).Worksheets("Faltantes Combustible").Cells(sw2, 1) <> ""
        Do While Workbooks(Archivos).Worksheets("Faltantes Combustible").Cells(5, fec) <> "Total Mes"
            If Workbooks(Archivos).Worksheets("Faltantes Combustible").Cells(sw2, fec) <> "" Then
                Workbooks("Status_Faltantes_Mayo2017.xlsm").Worksheets("Descuentos_Mayo").Cells(a, 6) = Workbooks(Archivos).Worksheets("Faltantes Combustible").Cells(5, fec) 'Fecha

                Workbooks("Status_Faltantes_Mayo2017.xlsm").Worksheets("Descuentos_Mayo").Cells(a, 9) = Workbooks(Archivos).Worksheets("Faltantes Combustible").Cells(sw2, 2) 'Rut

                Workbooks("Status_Faltantes_Mayo2017.xlsm").Worksheets("Descuentos_Mayo").Cells(a, 12) = Workbooks(Archivos).Worksheets("Faltantes Combustible").Cells(sw2, fec) 'Monto

                a = a + 1
                fec = fec + 1
            Else
            fec = fec + 1
            End If
 
        Loop
        sw2 = sw2 + 1
        fec = 3
    Loop
 
    Workbooks(Archivos).Activate
    Sheets("Faltantes Tienda").Select
 
    sw2 = 6
    Do While Workbooks(Archivos).Worksheets("Faltantes Tienda").Cells(sw2, 1) <> ""
        Do While Workbooks(Archivos).Worksheets("Faltantes Tienda").Cells(5, fec) <> "Total Mes"
            If Workbooks(Archivos).Worksheets("Faltantes Tienda").Cells(sw2, fec) <> "" Then
                Workbooks("Status_Faltantes_Mayo2017.xlsm").Worksheets("Descuentos_Mayo").Cells(a, 6) = Workbooks(Archivos).Worksheets("Faltantes Tienda").Cells(5, fec) 'Fecha

                Workbooks("Status_Faltantes_Mayo2017.xlsm").Worksheets("Descuentos_Mayo").Cells(a, 9) = Workbooks(Archivos).Worksheets("Faltantes Tienda").Cells(sw2, 2) 'Rut

                Workbooks("Status_Faltantes_Mayo2017.xlsm").Worksheets("Descuentos_Mayo").Cells(a, 12) = Workbooks(Archivos).Worksheets("Faltantes Tienda").Cells(sw2, fec) 'Monto

                a = a + 1
                fec = fec + 1
            Else
            fec = fec + 1
            End If
 
        Loop
        sw2 = sw2 + 1
        fec = 3
    Loop
 
 
    'ActiveWorkbook.Close Savechanges:=False

    Workbooks(Archivos).Close Savechanges:=False
 
    Archivos = Dir
    Loop
 
    End Sub
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
sin imagen de perfil

abrir archivos distintos,extraer datos, cerrar archivos

Publicado por Oscar Rodrigo (3 intervenciones) el 12/05/2017 03:31:47
gracias por el dato, haré las modificaciones por variables. Solo me falta ir cambiando la sub carpeta para que siga leyendo los archivos restantes.
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
Imágen de perfil de Andres Leonardo
Val: 3.136
Plata
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

abrir archivos distintos,extraer datos, cerrar archivos

Publicado por Andres Leonardo (1583 intervenciones) el 11/05/2017 16:06:41
si me posteas un ejempoo con un par de carpetas y un par de archivos por carpeta
y la hoja como la quieres consolidad ... yo te lo hago ... no es demasiado dificil... siempre y cuand o todos los archivos tengan la misma estructura.....todos....
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