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
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
