Quiero guardar datos de dos hojas distintas a una sola

Estoy realizando una macro, en la cual requiero guardar algunos datos de la Hoja "Datos" y de de la hoja "Codigos", en la Hoja " Plantilla Final". Los datos de un producto están ordenados por filas y sus características en columnas.

Por ejemplo: Necesito traspasar datos de cada producto de esta manera. (Las letras entre paréntesis son las columnas en las que se encuentran dichas características )

Datos ------------------> Plantilla Final

Contacto (O)------------> (G)

Teléfono (Q)------------> (H)

Cantidad (V)------------>(P)

Codigo (Y)--------------->(Q)

Precio Unitario (AB)-------------->(U)

Hoja Códigos--------------> Plantilla Final

Categoría (B)-------------->(O)

Medida (D)------------------>(R)

Modelo (E)------------------->(S)

Marca (C)------------------->(T)

Para poder traspasar los datos de la hoja códigos a plantilla final, se debe realizar una búsqueda del código contenido en la hoja datos (columna Y) y buscarlo en la columna A de la hoja códigos, para guardar la información contenida en las columnas adyacentes a ese código (columnas B, C, D, E de la hoja códigos). Además necesito que me inserte la fila entremedio en la hoja plantilla final siempre y cuando el código pertenezca a la misma orden de compra (columna D en plantilla final y columna en hoja datos).

Hasta el momento tengo este código separados para guardar los datos e insertar las filas, pero no me funciona. Agradecería si alguien pueda corregirlo o ayudarme con uno nuevo en caso de que no sirva.

Sub Macro()
    Set h1 = Sheets("Planilla Final")
    Set h2 = Sheets("Datos")
    Set h3 = Sheets("Codigos")
    n = 1
    u = h1.Range("Q" & Rows.Count).End(xlUp).Row + 1
    For i = 2 To h2.Range("Q" & Rows.Count).End(xlUp).Row
            If h2.Cells(i, "Y") <> "" Then
            h1.Cells(u, "H") = h2.Cells(i, "Q") 'tel
            h1.Cells(u, "G") = h2.Cells(i, "O") 'contacto
            h1.Cells(u, "P") = h2.Cells(i, "V") 'cantidad
            h1.Cells(u, "U") = h2.Cells(i, "AB") 'precio
            codigo = h2.Cells(i, "Y")
            If IsNumeric(codigo) Then codigo = Val(codigo)
            h1.Cells(u, "Q") = codigo                   'codigo
            Set b = h3.Columns("A").Find(codigo, lookat:=xlWhole)
            If Not b Is Nothing Then
            h1.Cells(u, "O") = h3.Cells(b.Row, "B") 'categoría
            h1.Cells(u, "R") = h3.Cells(b.Row, "D") 'medida
            h1.Cells(u, "S") = h3.Cells(b.Row, "E") 'modelo
            h1.Cells(u, "T") = h3.Cells(b.Row, "C") 'marca
            Else
               h1.Cells(u, "Q") = "no existe el código"
            End If
        u = u + 1
            End If
        Next
       u = h1.Range("Q" & Rows.Count).End(xlUp).Row
End Sub
Sub Insertarfila()
  If h2.Cells(i, "A") = h1.Cells(u, "D") Then
            fila = ActiveCell.Row   'reconozca la fila en la que estoy
            Rows(fila + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Range("B" & fila & ":N" & fila).Copy Range("B" & fila + 1)
            Rows(fila + 1).Select
            End Sub

1 respuesta

Respuesta
1

Te anexo la macro actualizada

Sub Guardar_Datos()
'---
'   Por.Dante Amor
'---
    '
    Set h1 = Sheets("Datos")            'origen
    Set h2 = Sheets("Planilla Final")   'destino
    Set h3 = Sheets("Codigos")
    '
    For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
        'buscar numero_oc
        numero_oc = h1.Cells(i, "A")
        Set b = h2.Columns("D").Find(numero_oc, lookat:=xlWhole)
        If Not b Is Nothing Then
            h2.Rows(b.Row + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            u = b.Row + 1
        Else
            u = h2.Range("D" & Rows.Count).End(xlUp).Row + 1
        End If
        '
        h2.Cells(u, "D") = numero_oc         'numero_oc
        h2.Cells(u, "G") = h1.Cells(i, "O")  'contacto
        h2.Cells(u, "H") = h1.Cells(i, "Q")  'tel
        h2.Cells(u, "P") = h1.Cells(i, "V")  'cantidad
        h2.Cells(u, "U") = h1.Cells(i, "AB") 'precio
        '
        'buscar codigo
        codigo = h1.Cells(i, "Y")
        If IsNumeric(codigo) Then codigo = Val(codigo)
        Set b = h3.Columns("A").Find(codigo, lookat:=xlWhole)
        If Not b Is Nothing Then
            h2.Cells(u, "O") = h3.Cells(b.Row, "B") 'categoría
            h2.Cells(u, "Q") = codigo               'codigo
            h2.Cells(u, "R") = h3.Cells(b.Row, "D") 'medida
            h2.Cells(u, "S") = h3.Cells(b.Row, "E") 'modelo
            h2.Cells(u, "T") = h3.Cells(b.Row, "C") 'marca
        Else
            h1.Cells(u, "Q") = "no existe el código"
        End If
    Next
    MsgBox "Fin"
End Sub

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

¡Gracias! 

Gracias Dante Nuevamente!!

Te anexo otra versión

Sub Guardar_Datos()
'---
'   Por.Dante Amor
'---
    '
    Set h1 = Sheets("Datos")            'origen
    Set h2 = Sheets("Planilla Final")   'destino
    Set h3 = Sheets("Codigos")
    '
    For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
        'buscar numero_oc
        numero_oc = h1.Cells(i, "A")
        'Set b = h2.Columns("D").Find(numero_oc, lookat:=xlWhole)
        'If Not b Is Nothing Then
            'h2.Rows(b.Row + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            'u = b.Row + 1
        'Else
            h2.Rows(2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            u = 2
        'End If
        '
        h2.Cells(u, "D") = numero_oc         'numero_oc
        h2.Cells(u, "G") = h1.Cells(i, "O")  'contacto
        h2.Cells(u, "H") = h1.Cells(i, "Q")  'tel
        h2.Cells(u, "P") = h1.Cells(i, "V")  'cantidad
        h2.Cells(u, "U") = h1.Cells(i, "AB") 'precio
        '
        'buscar codigo
        codigo = h1.Cells(i, "Y")
        If IsNumeric(codigo) Then codigo = Val(codigo)
        Set b = h3.Columns("A").Find(codigo, lookat:=xlWhole)
        If Not b Is Nothing Then
            h2.Cells(u, "O") = h3.Cells(b.Row, "B") 'categoría
            h2.Cells(u, "Q") = codigo               'codigo
            h2.Cells(u, "R") = h3.Cells(b.Row, "D") 'medida
            h2.Cells(u, "S") = h3.Cells(b.Row, "E") 'modelo
            h2.Cells(u, "T") = h3.Cells(b.Row, "C") 'marca
        Else
            h1.Cells(u, "Q") = "no existe el código"
        End If
    Next
    MsgBox "Fin"
End Sub

sa l u dos

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas