Tengo problemas para extraer los datos de los archivos de Excel a uno solo con la marco que dejaste

Tengo en una carpeta todos los archivos de Excel que deseo bajarles la información, pero utilizo la macro que dejaste y no me ha funcionado, ¿me podrías colaborar por favor?

La macro que estoy usando es:

Sub libros()
'Lee archivos del directorio y Copia la hoja 1
'Por.Dam
Application.ScreenUpdating = False
ruta = ThisWorkbook.Path
ChDir ruta
archi = Dir("*.xls*")
Set h1 = ThisWorkbook.Sheets("hoja1")
On Error Resume Next
Do While archi <> ""
    If InStr(1, archi, "nuevo") = 0 Then
        Workbooks.Open archi
        If Err.Number = 0 Then
            Sheets(1).Select
            Range(Range("A1"), ActiveCell.SpecialCells(xlLastCell)).Copy _
            h1.Range("A" & h1.Range("A1").SpecialCells(xlLastCell).Row + 1)
        Else
            Err.Number = 0
        End If
        Application.DisplayAlerts = False
        Workbooks(archi).Close
        Application.DisplayAlerts = True
    End If
    archi = Dir()
Loop
End Sub

1 respuesta

Respuesta
1

Para que se más práctico pon los libros en una carpeta diferente a donde tienes el libro con la macro y prueba con esta:

Sub libros()
'Lee archivos del directorio y Copia la hoja 1
'Por.Dam
Application.ScreenUpdating = False
ruta = "C:\trabajo\"
ChDir ruta
archi = Dir("*.xls*")
Set h1 = ThisWorkbook.Sheets("hoja1")
'On Error Resume Next
Do While archi <> ""
    'If InStr(1, archi, "nuevo") = 0 Then
        Workbooks.Open archi
        If Err.Number = 0 Then
            Sheets(1).Select
            Range(Range("A1"), ActiveCell.SpecialCells(xlLastCell)).Copy _
            h1.Range("A" & h1.Range("A1").SpecialCells(xlLastCell).Row + 1)
        Else
            Err.Number = 0
        End If
        Application.DisplayAlerts = False
        Workbooks(archi).Close
        Application.DisplayAlerts = True
    'End If
    archi = Dir()
Loop
End Sub

Cambia "C:\trabajo\" por la carpeta donde tienes tus archivos.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas