Anónimo
Macros que en una columna te indique el nombre del excel del cual se extrajo.
Sr. Dante Amor Tengo una macros de compilado, pero quisiera que en la columna "E" me indique el nombre del excel del cual se extrajeron esos datos .
Sub Consolidar()
Dim Archivos As Variant
Dim ArchivoMaestro As Workbook
Dim ArchivoActual As Workbook
Dim N As Integer
Dim ultimafila As String
Application.DisplayAlerts = False
Set ArchivoMaestro = ActiveWorkbook
Archivos = Application.GetOpenFilename(filefilter:="Excel Files,*.xls", _
MultiSelect:=True)
If IsArray(Archivos) Then
Application.ScreenUpdating = False
For N = LBound(Archivos) To UBound(Archivos)
Workbooks.Open Filename:=Archivos(N)
Range(Range("A2"), Range("A2").SpecialCells(xlLastCell)).Copy
Set ArchivoActual = ActiveWorkbook
ArchivoMaestro.Activate
Sheets("Consolidación").Select
Range("A1048576").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
ArchivoActual.Close SaveChanges:=False
Next
Else
Exit Sub
End If
End Sub
1 respuesta
H o l a:
Tienes pendiente valorar esta respuesta:
Al final de mi respuesta hay 2 opciones para valorar: "Votar" y "Excelente", si todavía tienes dudas, puedes solicitar más información, si la respuesta cumple con lo que solicitaste, esperaría que cambiaras la valoración. 
¡Gracias!
Ya lo hice estimado amigo .
Si me pudieras ayudar con esta duda seria excelente
Saludos.
Te anexo la macro actualizada
Sub Consolidar()
Dim Archivos As Variant
Dim ArchivoMaestro As Workbook
Dim ArchivoActual As Workbook
Dim N As Integer
Dim ultimafila As String
Application.DisplayAlerts = False
Set ArchivoMaestro = ActiveWorkbook
Archivos = Application.GetOpenFilename(filefilter:="Excel Files,*.xls", _
MultiSelect:=True)
If IsArray(Archivos) Then
Application.ScreenUpdating = False
For N = LBound(Archivos) To UBound(Archivos)
Workbooks.Open Filename:=Archivos(N)
Range(Range("A2"), Range("A2").SpecialCells(xlLastCell)).Copy
Set ArchivoActual = ActiveWorkbook
ArchivoMaestro.Activate
Sheets("Consolidación").Select
Range("A1048576").End(xlUp).Offset(1, 0).Select
fini = ActiveCell.Row
ActiveSheet.Paste
ffin = Range("A" & Rows.Count).End(xlUp).Row
Range("E" & fini & ":" & "E" & ffin) = ArchivoActual.Name
ArchivoActual.Close SaveChanges:=False
Next
'Else
' Exit Sub
End If
End Sub