Macro para cargar los datos correspondientes a un documento en excel

Tengo una base de datos y otra donde cargo una columna con documentos para traer los registros asociados

1

1 Respuesta

4.182.650 pts. Sancho, si los perros ladran ...

H o l a:

Si no quieres utilizar el offset, te anexo la siguiente alternativa para utilizar Cells:

Private Sub Worksheet_Change(ByVal Target As Range)
'Act.Por.Dante Amor
    If Target.Count > 1000 Then Exit Sub
    If Target.Column <> 1 Then Exit Sub
    '
    Set h = Sheets("Octubre")       'la variable h guarda la hoja de la búsqueda
    Set r = h.Range("B2:B10000")    'la variable r guarda el rango de la búsqueda
    '
    For Each c In Target            'Para cada celda copiada
                                    'El objeto b guarda el resultado de la búsqueda
        Set b = r.Find(c, LookIn:=xlValues, LookAt:=xlWhole)
        If Not b Is Nothing Then    'si encontró el dato devolverá el resto de datos
            Cells(c.Row, "B") = h.Cells(b.Row, "C")
            Cells(c.Row, "C") = h.Cells(b.Row, "D")
            Cells(c.Row, "D") = h.Cells(b.Row, "E")
            Cells(c.Row, "E") = h.Cells(b.Row, "H")
            Cells(c.Row, "F") = h.Cells(b.Row, "J")
            Cells(c.Row, "G") = h.Cells(b.Row, "K")
            Cells(c.Row, "H") = h.Cells(b.Row, "L")
        End If
    Next
End Sub

':)
S a l u d o s . D a n t e   A m o r
':) Si es lo que necesitas. Recuerda valorar la respuesta. G r a c i a s.

Mil gracias justo lo que necesitaba

Estoy teniendo problemas: cuando encuentra dos documentos me carga la información del segundo igual a la del primero me puedes ayudar por favor.

pdt pueden repetirse los documentos pero el resto de los datos son diferentes

H o l a:

La clave para la búsqueda es el documento, si existen 2 o más documentos iguales, entonces necesitamos de una segunda clave para identificar cuál registro pertenece a cuál documento.

¿Dime si tienes una segunda clave?

Si podría ser la subpartida, De la hoja Mes seria la columna H, y de la hoja XML se la columna Y,

Private Sub Worksheet_Change(ByVal Target As Range)
'Act.Por.Dante Amor
    If Target.Count > 1000 Then Exit Sub
    If Target.Column <> 1 Then Exit Sub
    '
    Set h = Sheets("Mes")       'la variable h guarda la hoja de la búsqueda
    Set r = h.Range("B2:B10000")    'la variable r guarda el rango de la búsqueda
    Set h2 = Sheets("xml")       'la variable h guarda la hoja de la búsqueda
    Set r2 = h2.Range("M2:M10000")    'la variable r guarda el rango de la búsqueda
    '
    For Each c In Target            'Para cada celda copiada
                                    'El objeto b guarda el resultado de la búsqueda
        Set b = r.Find(c, LookIn:=xlValues, LookAt:=xlWhole)
        If Not b Is Nothing Then    'si encontró el dato devolverá el resto de datos
            Cells(c.Row, "B") = h.Cells(b.Row, "C")
            Cells(c.Row, "C") = h.Cells(b.Row, "D")
            Cells(c.Row, "D") = h.Cells(b.Row, "E")
            Cells(c.Row, "E") = h.Cells(b.Row, "H")
            Cells(c.Row, "F") = h.Cells(b.Row, "J")
            Cells(c.Row, "G") = h.Cells(b.Row, "K")
            Cells(c.Row, "H") = h.Cells(b.Row, "L")
        End If
                For Each c2 In Target            'Para cada celda copiada
                                                 'El objeto b guarda el resultado de la búsqueda
                     Set b2 = r2.Find(c2, LookIn:=xlValues, LookAt:=xlWhole)
                     If Not b2 Is Nothing Then    'si encontró el dato devolverá el resto de datos
                         Cells(c2.Row, "I") = h2.Cells(b2.Row, "N")
                         Cells(c2.Row, "J") = h2.Cells(b2.Row, "O")
                         Cells(c2.Row, "K") = h2.Cells(b2.Row, "P")
                         Cells(c2.Row, "L") = h2.Cells(b2.Row, "Y")
                         Cells(c2.Row, "M") = h2.Cells(b2.Row, "Z")
                         Cells(c2.Row, "N") = h2.Cells(b2.Row, "AA")
                         Cells(c2.Row, "O") = h2.Cells(b2.Row, "AB")
                         Cells(c2.Row, "P") = h2.Cells(b2.Row, "AC")
                         Cells(c2.Row, "Q") = h2.Cells(b2.Row, "AD")
                         Cells(c2.Row, "R") = h2.Cells(b2.Row, "AF")
                         Cells(c2.Row, "S") = h2.Cells(b2.Row, "AG")
                         Cells(c2.Row, "T") = h2.Cells(b2.Row, "AH")
                         Cells(c2.Row, "U") = h2.Cells(b2.Row, "AI")
                     End If
    Next
    Next
    End Sub

¡Gracias! 

Private Sub Worksheet_Change(ByVal Target As Range)
'Act.Por.Dante Amor
    If Target.Count > 1000 Then Exit Sub
    If Target.Column <> 1 Then Exit Sub
    '
    Set h = Sheets("Mes")       'la variable h guarda la hoja de la búsqueda
    Set r = h.Range("B2:B10000")    'la variable r guarda el rango de la búsqueda
    Set h2 = Sheets("xml")       'la variable h guarda la hoja de la búsqueda
    Set r2 = h2.Range("M2:M10000")    'la variable r guarda el rango de la búsqueda
    '
    For Each c In Target            'Para cada celda copiada
                                    'El objeto b guarda el resultado de la búsqueda
        Set b = r.Find(c, LookIn:=xlValues, LookAt:=xlWhole)
        If Not b Is Nothing Then    'si encontró el dato devolverá el resto de datos
            Cells(c.Row, "B") = h.Cells(b.Row, "C")
            Cells(c.Row, "C") = h.Cells(b.Row, "D")
            Cells(c.Row, "D") = h.Cells(b.Row, "E")
            Cells(c.Row, "E") = h.Cells(b.Row, "H")
            Cells(c.Row, "F") = h.Cells(b.Row, "J")
            Cells(c.Row, "G") = h.Cells(b.Row, "K")
            Cells(c.Row, "H") = h.Cells(b.Row, "L")
        End If
                For Each c2 In Target            'Para cada celda copiada
                                                 'El objeto b guarda el resultado de la búsqueda
                     Set b2 = r2.Find(c2, LookIn:=xlValues, LookAt:=xlWhole)
                     If Not b2 Is Nothing Then    'si encontró el dato devolverá el resto de datos
                         Cells(c2.Row, "I") = h2.Cells(b2.Row, "N")
                         Cells(c2.Row, "J") = h2.Cells(b2.Row, "O")
                         Cells(c2.Row, "K") = h2.Cells(b2.Row, "P")
                         Cells(c2.Row, "L") = h2.Cells(b2.Row, "Y")
                         Cells(c2.Row, "M") = h2.Cells(b2.Row, "Z")
                         Cells(c2.Row, "N") = h2.Cells(b2.Row, "AA")
                         Cells(c2.Row, "O") = h2.Cells(b2.Row, "AB")
                         Cells(c2.Row, "P") = h2.Cells(b2.Row, "AC")
                         Cells(c2.Row, "Q") = h2.Cells(b2.Row, "AD")
                         Cells(c2.Row, "R") = h2.Cells(b2.Row, "AF")
                         Cells(c2.Row, "S") = h2.Cells(b2.Row, "AG")
                         Cells(c2.Row, "T") = h2.Cells(b2.Row, "AH")
                         Cells(c2.Row, "U") = h2.Cells(b2.Row, "AI")
                     End If
    Next
    Next
    End Sub

¡Gracias! 

H o l a:

Tengo que agregar un ciclo a la macro, podrías crear una pregunta nueva, 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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas