Extraer dato de otro libro

Buenas;
Tengo en una hoja de un libro Principal la siguiente macro hace que cuando yo escribo en la celda A1 una fecha Ej 01-03-2013 abre el libro llamado 03-2013 me toma el mes y año para buscar en una carpeta...
lo que quiero es cuando se abra el libro 03-2013 saque tres filas A , B , C de datos de la hoja1 del libro 03-2103 y los copie en la hoja2 del libro Principal
Gracias de antemano....

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False

On Error GoTo x

Dim Carpeta As String

Dim formato
Carpeta = "C:\ruta carpeta\"

If Target.Text = "" Then Exit Sub

formato = Format(Range("A1"), "mm-yyyyy")

Workbooks.Open (Carpeta & formato)

ActiveWorkbook.Save

ActiveWorkbook.Close

Exit Sub

x:

MsgBox "Archivo no encontrado", 64, ""

End Sub

1 Respuesta

Respuesta
1

Te regreso la macro con la actualización.

Esta línea sirve sólo en caso de que la celda A1 sea modificada, se ejecute la macro, de lo contrario, cada vez que actualices algo en la hoja se va a ejecutar la macro.

If Not Intersect(Target, Range("A1")) Is Nothing Then

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'Actualizado Por.DAM
Dim l1 As Worksheet
Application.ScreenUpdating = False
If Not Intersect(Target, Range("A1")) Is Nothing Then
    Set l1 = ThisWorkbook.Sheets("Hoja2")
    On Error GoTo x
    Dim Carpeta As String
     Dim formato
    Carpeta = "C:\ruta carpeta\"
    If Target.Text = "" Then Exit Sub
    formato = Format(Range("A1"), "mm-yyyy")
    Workbooks.Open (Carpeta & formato & ".xls")
    ActiveSheet.Columns("A:C").Copy l1.Range("A1")
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    Exit Sub
x:
    MsgBox "Archivo no encontrado", 64, ""
End If
End Sub

Saludos.DAM
Si es lo que necesitas.

Hola DAM

esta bien la macro resulta que me saca la columna A B C lo que quiero es sacar la fila

A37 hasta Q37 y la fila A39 hasta Q39

Aquí es donde he estado probando para cambiar columns por rows el rango y no se como hacerlo pero no pasa nada.

ActiveSheet.Columns("A:C").Copy l1.Range("A1")

Gracias

Me olvidaba

La linea

Workbooks.Open (Carpeta & formato & ".xls")

como se puede hacer para que habrá cualquier extensión de excel?

gracias

DAM

Ya pude sacar las filas que quiero y lo de las extensión también lo arregle..

Tengo otro pero

Cuando saco las filas las saca con formula y no se ve el resultado como hago para que me aparezca el resultado?

Gracias

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim l1 As Worksheet

Application.ScreenUpdating = False

If Not Intersect(Target, Range("M5")) Is Nothing Then

Set l1 = ThisWorkbook.Sheets("Hoja1")

On Error GoTo x

Dim Carpeta As String

Dim formato

Carpeta = "C:\Users\raul.peredo\Desktop\Caracterizaciones\"

If Target.Text = "" Then Exit Sub

formato = Format(Range("M5"), "mm-yyyy")

Workbooks.Open (Carpeta & formato)
ActiveSheet.Range("A37:Q39").Copy l1.Range("A2")

ActiveWorkbook.Save

ActiveWorkbook.Close

Exit Sub

x:

MsgBox "Archivo no encontrado", 64, ""

End If

End Sub

Cambia esta línea

ActiveSheet. Range("A37:Q39"). Copy l1. Range("A2")

Por estas:

ActiveSheet. Range("A37:Q39"). Copy
l1.Range("A2").PasteSpecial _
Paste:=xlPasteValuesAndNumberFormats, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False

Saludos. DAM
Si es lo que necesitas.

Perfecto Dam queda bien

Lo ultimo me di cuenta que cuando abre el libro de donde quiere sacar la información desde el ultima vez que se guardo Ej en el libro 02-2013 tiene 3 hojas hoja1 = hola , hoja 2= como , hoja 3 = estas

si estoy en el libro 02-2013 en la "hoja3 = estas" y guardo el libro para cerrarlo ..

en el libro principal cuando busco el libro 02-2013 para sacar la información me la saca de la "hoja 3 = estas" que fue lo ultimo que guardo ese libro

debería sacar de la "hoja 2=como"

como hago para que cuando se abra el libro 02-2013 vaya a la "hoja 2=como" y saque de ahi los datos aunque se haya guardado últimamente con otra hoja en este caso con la "hoja3=estas"....

Gracias

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim l1 As Worksheet

Application.ScreenUpdating = False

If Not Intersect(Target, Range("M5")) Is Nothing Then

Set l1 = ThisWorkbook.Sheets("Hoja1")

On Error GoTo x

Dim Carpeta As String

Dim formato

Carpeta = "C:\Users\raul.peredo\Desktop\Caracterizaciones\"

If Target.Text = "" Then Exit Sub

formato = Format(Range("M5"), "mm-y")

Workbooks.Open (Carpeta & formato)
ActiveSheet.Range("A37:Q39").Copy

l1.Range("A2").PasteSpecial _

Paste:=xlPasteValuesAndNumberFormats, _

Operation:=xlNone, _

SkipBlanks:=False, _

Transpose:=False

ActiveWorkbook.Save

ActiveWorkbook.Close

Hoja13.Select

Exit Sub

x:

MsgBox "Archivo no encontrado", 64, ""

End If

End Sub

Cambia esta línea

ActiveSheet. Range("A37:Q39"). Copy

Por esta

Sheets("como"). Range("A37:Q39"). Copy

Nota:

En todos los libros que abras deberá existir la hoja "como"

Saludos. DAM
Si es lo que necesitas.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas