Copiar o repetir datos por cada fila ocupada, y mantener estilo de borde

[pedrosilv]

Buena noche foristas.

Quisiera solicitar su apoyo para ver si puedo solucionar el siguiente inconveniente. Estoy trabajando unas tablas que permitirán llevar un mejor control de verduras.  He avanzado un poco, pero actualmente estoy parado en lo siguiente:

A partir de la celdas B3:C3 enlisto las verduras de la semana, el cual es un listado variable. Para el ejemplo, tengo 4 verduras, y lo que quisiera hacer es que con una macro, se copie estas verduras que ingresaron esta semana, y por cada verdura, se incerte en la columna anexa  4 parámetros dispuestos en fila, como son: Orígen, Variedad, Peso y el Vendedor. Además, mentener un estilo de borde, el cual describo en el ejemplo  anexo. El resultado final sería algo así:

No.  Verdura  Parámetro

1      Papa                 Orígen

                                      Variedad

                                      Peso

                                     Vendedor

2     Remolacha    Orígen

                                      Variedad

                                      Peso

                                     Vendedor

3     Cebolla           Orígen

                                      Variedad

                                      Peso

                                     Vendedor

 

Seguramente no me he explicado bien, por lo que adjunto el archivo de ejemplo, de cómo está y el resultado que quisiera obtener. 

Cualquier ayuda o sugerencia es bienvenida. Desde ya, muchas gracias por su apoyo.

 

Saludos

 

Ejemplo para insertar 4 filas por cada verdura.xlsx

[JSDJSD]

Prueba y comenta

Ejemplo para insertar 4 filas por cada verdura.xlsm

[JSDJSD]

Private Sub CommandButton1_Click()
    With Hoja1
        inicio = 4
        For cont = 4 To .Range("B" & Rows.Count).End(xlUp).Row
            .Range(.Cells(cont, 2), .Cells(cont, 3)).Copy _
                Destination:=.Cells(inicio, 8)
            .Range(.Cells(inicio, 8), .Cells(inicio, 9)).Interior.Color = RGB(255, 255, 0)
            .Cells(inicio, 9).Offset(0, 1) = "Orígen"
            .Cells(inicio, 9).Offset(1, 1) = "Variedad"
            .Cells(inicio, 9).Offset(2, 1) = "Peso"
            .Cells(inicio, 9).Offset(3, 1) = "Vendedor"
            inicio = inicio + 4
        Next cont
    End With
End Sub

 

[pedrosilv]

Muchísimas gracias JSDJSD. 

La macro me funciona muy bien para copiar e integrar los 4 valores. Solo tengo una consulta, por ejemplo, si deseo mantener el estilo de los bordes, cómo debería configurar la macro?

Desde ya, muchas gracias.

Saludos

[JSDJSD]

Ejemplo para insertar 4 filas por cada verdura.xlsm

[JSDJSD]

Private Sub CommandButton1_Click(): Application.ScreenUpdating = False
    With Hoja1
        inicio = 4
        For cont = 4 To .Range("B" & Rows.Count).End(xlUp).Row
            .Range(.Cells(cont, 2), .Cells(cont, 3)).Copy
            .Range(.Cells(inicio, 8), .Cells(inicio, 9)).PasteSpecial Paste:=xlPasteValues
            .Cells(inicio, 9).Offset(0, 1) = "Orígen"
            .Cells(inicio, 9).Offset(1, 1) = "Variedad"
            .Cells(inicio, 9).Offset(2, 1) = "Peso"
            .Cells(inicio, 9).Offset(3, 1) = "Vendedor"
            inicio = inicio + 4
        Next cont
        .Cells(3, 2).Select
        Application.CutCopyMode = False
    End With
End Sub

 

[pedrosilv]

Muchas gracias por todo tu apoyo y el tiempo invertido mi estimado JSDJSD, sin embargo, aún no me funciona lo de los bordes.

Muy amable de tu parte.

Saludos

[JSDJSD]

Puedes mostrar lo que no te funciona?

[pedrosilv]

Buena tarde JSDJSD:

El procedimiento que me ayudaste a resolver, también lo quiero replicar en otro caso. Si los datos orígenes se encuentran en la Hoja18  a partir de B4 y los quiero pegar en la Hoja19 a partir de la celdas A15, no encuentro la forma de adaptarlo, por ahora así voy:

Sub Comerciales()
   
   Application.ScreenUpdating = False
    With Hoja18
        inicio = 4
        pega = 15
        For cont = 4 To .Range("B" & Rows.Count).End(xlUp).Row
            .Range(.Cells(cont, 2)).Copy
             Hoja19.Range(.Cells(pega, 1)).PasteSpecial Paste:=xlPasteValues
            .Cells(pega, 2).Offset(0, 1) = "N"
            .Cells(pega, 2).Offset(1, 1) = "G (m2)"
            .Cells(pega, 2).Offset(2, 1) = "V Com (m3)"
            .Cells(pega, 2).Offset(3, 1) = "V Tot (m3)"
            inicio = inicio + 4
            pega = pega + 4
        Next cont
        .Cells(3, 2).Select
        Application.CutCopyMode = True
    End With
End Sub

Respecto a lo anterior, no me funcional el procedimiento para aplicar el estilo de bordes iniciales, es decir, que la macro aplique el estilo de bordeado, ya que pueden ser más de 4 especies. 

 

Gracias por tu atención y ayuda

[JSDJSD]

hace 23 horas, pedrosilv dijo:

El procedimiento que me ayudaste a resolver, también lo quiero replicar en otro caso. Si los datos orígenes se encuentran en la Hoja18  a partir de B4 y los quiero pegar en la Hoja19 a partir de la celdas A15, no encuentro la forma de adaptarlo, por ahora así voy:

Private Sub CommandButton1_Click(): Application.ScreenUpdating = False
    inicio = 15
    With Hoja19
        For cont = 4 To Hoja18.Range("B" & Rows.Count).End(xlUp).Row
            Hoja18.Range(Hoja18.Cells(cont, 2), Hoja18.Cells(cont, 3)).Copy
            .Range(.Cells(inicio, 1), .Cells(inicio, 2)).PasteSpecial Paste:=xlPasteValues
            .Cells(inicio, 2).Offset(0, 1) = "Orígen"
            .Cells(inicio, 2).Offset(1, 1) = "Variedad"
            .Cells(inicio, 2).Offset(2, 1) = "Peso"
            .Cells(inicio, 2).Offset(3, 1) = "Vendedor"
            inicio = inicio + 4
        Next cont
        Application.CutCopyMode = False
    End With
End Sub

 

[JSDJSD]

Ejemplo para insertar 4 filas por cada verdura.xlsm

[JSDJSD]

hace 23 horas, pedrosilv dijo:

Respecto a lo anterior, no me funcional el procedimiento para aplicar el estilo de bordes iniciales, es decir, que la macro aplique el estilo de bordeado, ya que pueden ser más de 4 especies. 

Sigo sin entender que me quieres decir, sube un ejemplo de como lo tienes y como quieres que quede

 

[pedrosilv]

Muchisimas gracias por toda tu ayuda mi estimado JSDJSD.

Me ha servido el código que me enviaste. No sabes cuánto voy a avanzar con ello.

Saludos.