Código para leer archivos no duplicados

Solo consultas sobre macros y código VBA Excel.
Reglas del Foro 1. Antes de hacer tu pregunta intenta con el buscador de este foro (muchas preguntas ya fueron respondidas antes!)
2. Si haces una nueva pregunta, es muy recomendable que adjuntes el ejemplo Excel para poder comprenderla mejor!
3. Realiza tu pregunta de forma clara, explicando bien cada paso de lo que haces y tendrás más probabilidad de respuesta!

Código para leer archivos no duplicados

Notapor NicoAlejandro » 11 Ene 2018 11:38

Hola, tengo una duda a la cual no he podido encontrar solución. Necesito consolidar información de muchos archivos excel en uno solo, es decir, de 800 archivos en la misma carpeta, leer cada uno, copiar unas celdas y pegarlas en mi nuevo excel llamado "Resumen". Esto ya lo tengo hecho, pero mi problema es que en el futuro se quiere agregar nuevos archivos, y no se cómo programar que lea solo los archivos nuevos. La idea es no usar la eliminación de duplicados, ya que son tantos archivos que se demora en ejecutar la macro.
En mi excel actual, tengo en la columna B con el código de identificación de cada archivo, que es de la forma "E-2113" (No pasa de los 4 dígitos por ahora). Los archivos excel comienzan con esto, además de que su hoja activa tiene este código, pero tienen más cosas en sus títulos, sin un formato específico.
Además, uso el típico "Fila=fila+1" para que ingrese los datos en la fila siguiente. Cada vez que ejecuto la macro comienza en la fila 2, pero como ahora debo agregar mas datos ésto me reemplazaría los datos ya existentes. ¿Hay alguna forma de que anote los datos después de la última fila sin datos?

Mi código lo dejo a continuación, muchas gracias si pueden ayudarme!!!
Mi libro de excel se llama Resumen, y la macro Resumenes. Todo se realiza en la "Hoja1"

Código: Seleccionar todo
Sub resumenes()
Dim fila As Long
Application.ScreenUpdating = False
fila = 2
ruta = ThisWorkbook.Path
ChDir ruta
archi = Dir("*.xlsx")
Set h1 = ThisWorkbook.Sheets("hoja1")
On Error Resume Next
Do While archi <> ""
    If InStr(1, archi, "Resumen") = 0 Then
               
        Workbooks.Open archi
       
        If Err.Number = 0 Then
             
           
            h1.Range("b" & fila) = ActiveSheet.Name
                       
            Range("h2").Copy
            h1.Range("c" & fila).PasteSpecial xlPasteValues
           
             Range("h4").Copy
            h1.Range("d" & fila).PasteSpecial xlPasteValues
           
            Range("e1").Copy
            h1.Range("e" & fila).PasteSpecial xlPasteValues
           
            Range("p6").Copy
            h1.Range("f" & fila).PasteSpecial xlPasteValues
                                 
            Range("p24").Copy
            h1.Range("g" & fila).PasteSpecial xlPasteValues
           
            a = Range("p26:p31")
            resultado = Application.WorksheetFunction.Sum(a)
            h1.Range("h" & fila) = resultado
           
            Range("t6").Copy
            h1.Range("i" & fila).PasteSpecial xlPasteValues
           
            Range("t16").Copy
            h1.Range("j" & fila).PasteSpecial xlPasteValues
           
            Range("p22").Copy
            h1.Range("k" & fila).PasteSpecial xlPasteValues
           
            Range("w6").Copy
            h1.Range("l" & fila).PasteSpecial xlPasteValues
           
            Range("w7").Copy
            h1.Range("m" & fila).PasteSpecial xlPasteValues
           
            Range("w8").Copy
            h1.Range("n" & fila).PasteSpecial xlPasteValues
           
            Range("w9").Copy
            h1.Range("o" & fila).PasteSpecial xlPasteValues
           
            Range("w10").Copy
            h1.Range("p" & fila).PasteSpecial xlPasteValues
           
            Range("w11").Copy
            h1.Range("q" & fila).PasteSpecial xlPasteValues
           
            Range("w12").Copy
            h1.Range("r" & fila).PasteSpecial xlPasteValues
           
            Range("w19").Copy
            h1.Range("s" & fila).PasteSpecial xlPasteValues
           
            fila = fila + 1
        Else
            Err.Number = 0
        End If
        Application.DisplayAlerts = False
        Workbooks(archi).Close
        Application.DisplayAlerts = True
    End If
    archi = Dir()
Loop
End Sub
NicoAlejandro
Miembro Nuevo
Miembro Nuevo
 
Mensajes: 1
Registrado: 11 Ene 2018 11:08

Re: Código para leer archivos no duplicados

Notapor Antoni » 11 Ene 2018 16:33

A bote pronto se me ocurre tener una hoja auxiliar donde guardar los archivos procesado o mover los archivos ya procesados a otra carpeta.
Comenta que solución te parece mas adecuada para ti y mañana le echaré un vistazo.
Avatar de Usuario
Antoni
Miembro Frecuente
Miembro Frecuente
 
Mensajes: 5028
Registrado: 22 Dic 2009 04:58
Ubicación: GALICIA (ESPAÑA)


Volver a Macros

¿Quién está conectado?

Usuarios navegando por este Foro: Bing [Bot] y 3 invitados