¿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
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 SubPrueba y me comentas
Saludos. DAM
Si es lo que necesitas.
Saludos DAM la macro cumple su objetivo, pero quisiera que al copiar solo copiara valores y no los formatos - Francisco Jaimes
Con referente al comentario anterior, he visto esta línea de código pero no se si pudiera ensamblar con la macro anterior'Seleccionar rango de celdasorigenrngOrigen.SelectRange(Selection, Selection.End(xlDown)).SelectRange(Selection, Selection.End(xlToRight)).SelectSelection.Copy 'Pegar datos en celda destinorngDestino.PasteSpecial xlPasteValuesApplication.CutCopyMode = False - Francisco Jaimes
Disculpa seguí tu consejo para que no quedara amontonada pero no funiciono - Francisco Jaimes
Hola: Lo que pasa que aquí en los comentarios no es el lugar para realizar una consulta. Con mucho gusto te ayudo con todas tus peticiones.Crea una nueva pregunta en todoexpertos, en el tema de microsoft excel, en el desarrollo de la pregunta escribe: "para Dante Amor", ahí me describes con detalle lo que necesitas.Sal u dos - Dante Amor