Macro para abrir varios archivos de Excel de diferentes carpetas y copiar la información de cada uno, en un mismo libro maestro.

Tengo una carpeta maestra, donde tengo "n" cantidad de subcarpetas, estas contienen a su vez, archivos pdf, dwg, pero los que me interesan son los archivos de excel, necesito abrir estos archivos y copiar toda la información de cada una de ellos en un mismo libro maestro. Esta información es similar en cantidad de columnas, varia en el tipo de información que contiene cada celda y en la cantidad de filas, pero están acomodadas dentro del mismo formato. Estos pueden llegar a ser hasta 15 mil líneas o más...

Una vez que termine de copiar el contenido de todos los libros en el libro maestro de excel, la macro lea la columna H y reconozca fila por fila, 1 por 1, si se repite la información, en caso que coincida (supongamos la celda H10 y H11 ) compare la información de la columna J de estas mismas filas(J10 y J11), en ella se encontraran revisiones (0, 1, 2, 3 ... RZ) y deje únicamente la ultima revisión, eliminando las otras filas. Ejemplo:

                            Columna H                                                                Columna J

10                     A7714-AB-STR-0053-001                                                1

11                     A7714-AB-STR-0053-001                                                2

12                     A7714-AB-STR-0053-001                                                3

La macro deberá reconocer que las filas 10, 11 y 12 tienen el mismo contenido en la columna H, pero difieren en la columna J, eliminara las filas 10 y 11, dejando únicamente el valor más alto.

Los valores de la columna J van de cero ( 0 ) hasta RZ, que es lo más alto.  ( ejemp. 0-1-2-3-4-5...RZ).

Espero haberme dado a entender y cualquier duda o comentario, estoy a sus ordenes. También les puedo enviar el archivo, de ser necesario.

2 Respuestas

Respuesta
1

La primer parte de abrir y copiar lo puedes hacer de esta manera;

Sub Open_Files()
Dim r&, s&
Dim b As Workbook
Dim Hoja As Object
    Application.ScreenUpdating = False
       'Definir la variable como tipo Variante
       Dim X As Variant
       'Abrir cuadro de dialogo
       X = Application.GetOpenFilename _
           ("Excel Files (*.xlsx), *.xlsx", 2, "Abrir archivos", , True)
        'Validar si se seleccionaron archivos
        If IsArray(X) Then ' Si se seleccionan
          'Crea Libro nuevo
        '*/********************
       For y = LBound(X) To UBound(X)
       Application.StatusBar = "Importando Archivos: " & X(y)
       r = ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
       Set b = Workbooks.Open(X(y))
         s = b.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
         b.Sheets(1).Range("A2:F" & s).Copy
         ThisWorkbook.Sheets(1).Range("A" & r + 1).Paste
        b.Close False
       Next
       Application.StatusBar = "Listo"
    End If
    Application.ScreenUpdating = False
   End Sub
Respuesta
2

Este ejemplo te puede quizás te pueda aportar algo más.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas