Macro importando datos especificos de diferentes archivos

H o l a:

Sigue las siguientes instrucciones:

1.- Crea un archivo nuevo.

2. - En la primera hoja del archivo nuevo pon los siguientes títulos en la fila 1 como se muestra en la imagen:

3.- En la columna "A" desde la fila 2 hacia abajo, pon el nombre de la carpeta origen, si tienes varios archivos, deberás escribir la carpeta por cada archivo; si tienes varios archivos en la misma carpeta, deberás repetir la carpeta en la columna A, tal y como se muestra el ejemplo.

4.- En la columna B escribe el nombre del archivo, no importa que el nombre del archivo se repita en diferentes carpetas, tal como se muestra en el ejemplo con el archivo "resumen".

5.- En la columna C escribe la extensión del archivo.

6.- La columna D la llena la macro.

7.- Ejecuta la macro.

8.- Los resultados son los siguientes:

• Te va a crear una hoja por cada archivo
• En cada hoja te va a poner la información de todas las hojas del archivo origen
• En la columna D te va a poner el estatus de cada archivo origen.

Prueba y me comentas. Pon la siguiente macro en un módulo:

Sub ImportarDatos()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets(1)
    '
    u = h1.Range("A" & Rows.Count).End(xlUp).Row
    h1.Range("D2:D" & u).ClearContents
    For n = l1.Sheets.Count To 2 Step -1
        Sheets(n).Delete
    Next
    celdas = Array("A", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y")
    For i = 2 To u
        ruta = h1.Cells(i, "A")
        arch = h1.Cells(i, "B")
        exte = h1.Cells(i, "C")
        If Dir(ruta & arch & exte) <> "" Then
            Set l2 = Workbooks.Open(ruta & arch & exte, , True)
            l1.Sheets.Add after:=l1.Sheets(l1.Sheets.Count)
            Set h2 = l1.ActiveSheet
            h2.Name = Left(arch, 26) & " " & Format(i, "000")
            j = 1
            k = 1
            For Each h In l2.Sheets
                Set r = h.Columns("A")
                Set b = r.Find("Nombre del caso", lookat:=xlPart)
                If Not b Is Nothing Then
                    ncell = b.Address
                    Do
                        'detalle
                        For c = LBound(celdas) To UBound(celdas)
                            h2.Cells(j, k) = h.Range(celdas(c) & b.Row)
                            k = k + 1
                        Next
                        k = 1
                        j = j + 1
                        Set b = r.FindNext(b)
                    Loop While Not b Is Nothing And b.Address <> ncell
                End If
            Next
            h1.Cells(i, "D") = "Archivo importado"
            l2.Close False
        Else
            h1.Cells(i, "D") = "No existe archivo"
        End If
    Next
    h1.Select
    Application.ScreenUpdating = True
    MsgBox "Fin"
End Sub

':)
':)

Hola Dante, agradezco muchísimo tu ayuda.

Seguí paso a paso tus indicaciones, pero al generar la macro me genera las hojas con el nombre correspondiente pero sin contenido, revisando los archivos Origen hay dos hojas que su contenido es diferente  a como las describí, y no se si también afecte que las filas donde inician con "Nombre caso:"  estén combinadas.

Te adjunto imagen de un archivo origen como ejemplo, para darme a entender mejor. En la primera es una de las hojas de las que no se extrae información pues no cumple con las condiciones que describí al principio; en la segunda imagen se ve la forma como están las hojas de donde se extrae la info

Si no es molestia te pido me ayudes a revisar pues como dije antes la verdad no tengo idea de macros.

Muchas gracias.

En tu pregunta original pusiste esto:

"

Si las filas donde la celda (A1:A1000) inician con "Nombre del caso:"

"

Ahora en tu imagen veo que dice: "NOMBRE CASO"

Corrige en la macro esta línea:

Set b = r.Find("Nombre del caso", lookat:=xlPart)

Por esta:

Set b = r.Find("NOMBRE CASO", lookat:=xlPart)

Prueba nuevamente.

':)
':)

Dante Amor:

Hice el cambio de "Nombre del caso:" por "Nombre caso:", pero aún así me genero las hojas sin información. Decidí modificar uno de los archivos quitando la combinación de celdas (en todas las hojas) ejecuté la macro y en la hoja correspondiente a ese archivo si me cargó los datos.  Pero como te dije antes no me es permitido modificar los archivos originales quitando la combinación de celdas.

Me ayudas, por fis.

H o l a:

Claro que te ayudo hasta que funcione.

Cambia en la macro esta línea:

Set r = h.Columns("A")

Por esta:

Set r = h.Columns("A:D")

':)
':)

¡Gracias! me funciono tal como quería.

Enserio muchísimas gracias, no se que hubiese sido sin tu ayuda.

H o l a:

Al final de mi respuesta hay dos botones: "Votar" y "Excelente".

La macro es bastante compleja para que solamente reciba tu calificación de "Votar".

Si la macro está completa, esperaría que cambiarlas la valoración, ahí mismo te aparece un botón que dice "Votada", presiona click y te aparece otro que dice "Cambiar votación".

E spero tus comentarios.