Revision de codigo (ayuda)
Publicado por sebastian (1 intervención) el 21/03/2017 16:17:38
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
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
Valora esta pregunta


0