Capturar los datos de una importación

Tengo una macro en un libro de excell donde selecciono otro libro la pestaña y el rango y lo importo a importo al primer libro. Como puedo guardar el path libro y rango de donde fueron importados los datos en el primer libro y ya pone, todas las características de archivo de donde fue importado ya seria excelente como hora día de creación, hora y día de modificación. Seria una cosa como, que en una o varias celdas del libro donde fueron importados lo datos pusiese Datos importados de c:/user/características/videos2016.xlsm rango a1:z:23 archivo creado 25/12/2016 11:50:23 modificado 27/12/2016 12:45:34.

1 respuesta

Respuesta
1

Puedes poner tu macro para actualizarla

Es esta hecha por ti

http://www.todoexpertos.com/preguntas/7iutkyt5ibkt6v8u/macro-para-importar-una-sheet-de-otro-libro?selectedanswerid=7iv7uw9lehkpd6my&nid=9wlprrmbfwl9rvuc9ntadwkm9rw63hkqg8u6hweqfknpbsenhvtalre4abr3 

Y si cuando ya seleccionaste un libro y te equivocaste, que exista otro botón para poder seleccionar otro libro, es decir que aparezca OK, cancelar, Otro libro

Gracias

H    o    l   a: Te anexo la macro. Funciona de igual forma, seleccionas la celda donde quieres pegar los datos.

Las propiedades del archivo (nombre, hoja, rango, creado y modificado), quedarán en la fila de arriba de tu celda seleccionada.

Después de abrir el archivo, te va a aparecer una pregunta para saber si el libro es el correcto, si es correcto, presiona Sí.

Si no es correcto y quieres otro, presiona No.

Si ya no quieres continuar, presiona Cancelar.

Sub CopiaRangoOtroLibro()
'Por.Dante Amor
    Set l1 = ThisWorkbook
    Set h1 = l1.ActiveSheet
    Set c1 = ActiveCell
    Set fso = CreateObject("Scripting.FileSystemObject")
    '
    If c1.Row = 1 Then
        MsgBox "Debes seleccionar una celda de la fila 2 en adelante"
        Exit Sub
    End If
    '
    Do While True
        Set c1 = ActiveCell
        With Application.FileDialog(msoFileDialogFilePicker)
            .Title = "Seleccione archivo de excel"
            .Filters.Clear
            .Filters.Add "Archivos excel", "*.xls*"
            .AllowMultiSelect = False
            .InitialFileName = l1.Path & "\"
            If Not .Show Then Exit Sub
            archivo = .SelectedItems.Item(1)
        End With
        '
        Workbooks.Open archivo
        Set l2 = ActiveWorkbook
        res = MsgBox("Es correcto el libro", vbQuestion + vbYesNoCancel, "COPIAR RANGO DE CELDAS")
        Select Case res
            Case vbYes
                variable = l2.Name
                With Application
                    On Error Resume Next
                    Set libro2 = .InputBox("SELECCIONA LA HOJA Y EL RANGO DE CELDAS A COPIAR ", "LIBRO2", _
                        Default:="[" & variable & "]Hoja1!$A$1", Type:=8)
                    If libro2 Is Nothing Then Exit Sub
                    On Error GoTo 0
                End With
                celda_2 = libro2.Address
                hoja_2 = libro2.Worksheet.Name
                libro_2 = libro2.Worksheet.Parent.Name
                Set h2 = l2.Sheets(hoja_2)
                h2.Range(celda_2).Copy
                h1.Range(c1.Address).PasteSpecial xlValues
                h1.Range(c1.Address).PasteSpecial xlFormats
                '
                Set prop = fso.Getfile(archivo)
                c1.Offset(-1, 0) = "Datos importados de : " & libro_2
                c1.Offset(-1, 1) = "Hoja : " & hoja_2
                c1.Offset(-1, 2) = "Rango : " & celda_2
                c1.Offset(-1, 3) = "Creado : " & prop.DateCreated
                c1.Offset(-1, 4) = "Modificado : " & prop.DateLastModified
                '
                l2.Close False
                MsgBox "Rango copiado", vbInformation, "COPIAR RANGO DE CELDAS"
                Exit Do
            Case vbNo
                'se repite el ciclo para seleccionar otro libro
                l2.Close False
            Case vbCancel
                'se cancela el proceso
                l2.Close False
                MsgBox "Proceso cancelado", vbExclamation, "COPIAR RANGO DE CELDAS"
                Exit Do
        End Select
    Loop
End Sub

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

Dante perdón por la tardanza de la contestación, funciona a las mil maravillas, ya para finalizar además de copiar las propiedades del archivo. ¿Se podría también copiar el path de ponde fue importado?

Gracias, si no es possible, dímelo y cierro la pregunta igual con un super excelente

.

Te anexo la macro actualizada

Sub CopiaRangoOtroLibro()
'Por.Dante Amor
    Set l1 = ThisWorkbook
    Set h1 = l1.ActiveSheet
    Set c1 = ActiveCell
    Set fso = CreateObject("Scripting.FileSystemObject")
    '
    If c1.Row = 1 Then
        MsgBox "Debes seleccionar una celda de la fila 2 en adelante"
        Exit Sub
    End If
    '
    Do While True
        Set c1 = ActiveCell
        With Application.FileDialog(msoFileDialogFilePicker)
            .Title = "Seleccione archivo de excel"
            .Filters.Clear
            .Filters.Add "Archivos excel", "*.xls*"
            .AllowMultiSelect = False
            .InitialFileName = l1.Path & "\"
            If Not .Show Then Exit Sub
            archivo = .SelectedItems.Item(1)
        End With
        '
        Workbooks.Open archivo
        Set l2 = ActiveWorkbook
        ruta2 = l2.Path
        res = MsgBox("Es correcto el libro", vbQuestion + vbYesNoCancel, "COPIAR RANGO DE CELDAS")
        Select Case res
            Case vbYes
                variable = l2.Name
                With Application
                    On Error Resume Next
                    Set libro2 = .InputBox("SELECCIONA LA HOJA Y EL RANGO DE CELDAS A COPIAR ", "LIBRO2", _
                        Default:="[" & variable & "]Hoja1!$A$1", Type:=8)
                    If libro2 Is Nothing Then Exit Sub
                    On Error GoTo 0
                End With
                celda_2 = libro2.Address
                hoja_2 = libro2.Worksheet.Name
                libro_2 = libro2.Worksheet.Parent.Name
                Set h2 = l2.Sheets(hoja_2)
                h2.Range(celda_2).Copy
                h1.Range(c1.Address).PasteSpecial xlValues
                h1.Range(c1.Address).PasteSpecial xlFormats
                '
                Set prop = fso.Getfile(archivo)
                c1.Offset(-1, 0) = "Datos importados de : " & libro_2
                c1.Offset(-1, 1) = "Hoja : " & hoja_2
                c1.Offset(-1, 2) = "Rango : " & celda_2
                c1.Offset(-1, 3) = "Creado : " & prop.DateCreated
                c1.Offset(-1, 4) = "Modificado : " & prop.DateLastModified
                c1.Offset(-1, 5) = "Ruta : " & ruta2
                '
                l2.Close False
                MsgBox "Rango copiado", vbInformation, "COPIAR RANGO DE CELDAS"
                Exit Do
            Case vbNo
                'se repite el ciclo para seleccionar otro libro
                l2.Close False
            Case vbCancel
                'se cancela el proceso
                l2.Close False
                MsgBox "Proceso cancelado", vbExclamation, "COPIAR RANGO DE CELDAS"
                Exit Do
        End Select
    Loop
End Sub

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas