¿Pero puedo hacer me me de el nombre de los archivos que copia? En el que unifica?

La macro para copiar datos de varios libros y pegarlos en un libro nuevo en la primera hoja me funciono perfecto, pero quiero saber si puedo hacer que me identifique el nobre de los archivos por que son fechas y necesito que me los incluya en que unifique

1 Respuesta

Respuesta
2

Puedes poner la macro y un ejemplo de cómo quieres que queden los datos.

Saludos. DAM

esta es la macro que tome de una respuesta a otro usuario me ha funcionado perfecto pero quisiera saber si es posible que en la consolidación de la información me identifique el nombre del archivo de donde toma los datos:

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") h1.Cells.Clear On Error Resume Next ffin = h1.UsedRange.Find(what:="*").Row ActiveCell.SpecialCells(xlLastCell).Select 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) End If Err.Number = 0 Application.DisplayAlerts = False Workbooks(archi).Close Application.DisplayAlerts = True End If archi = Dir() Loop End Sub

La macro que pusiste está toda amontonada, la puedes copiar, primero en WORD y después aquí.

Dime en qué columna quieres que se pongan los nombres de los archivos.

Escribe un ejemplo

Saludos. DAM

que pena, esta es la macro, 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

La copie de esta pagina y funciona a la perfección, pero necesito que el nombre del archivo aparezca en la columna A si es posible, y a partir de la B el contenido de lo que esta en el archivo.

Gracias

Cambia la macro por esta

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
            uf1 = h1.Range("A" & Rows.Count).End(xlUp).Row
            Range(Range("A1"), ActiveCell.SpecialCells(xlLastCell)).Copy _
            h1.Range("B" & uf1 + 1)
            uf2 = uf1 + ActiveCell.SpecialCells(xlLastCell).Row
            Application.DisplayAlerts = False
            Workbooks(archi).Close
            Application.DisplayAlerts = True
            If uf1 > 1 Then uf1 = uf1 + 1
            Range("A" & uf1 & ":A" & uf2) = archi
        Else
            Err.Number = 0
        End If
    End If
    archi = Dir()
Loop
End Sub

Prueba y me comentas

Saludos. DAM
Si es lo que necesitas.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas