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

1 respuesta

Respuesta
1

H o  l a:

Tienes pendiente valorar esta respuesta:

Macros que al encontrar la palabra "Isotype" dentro de la columna "A" Se añadan 2 filas encima de esta .

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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas