Jose Romero: Como realizar macro para concatenar rangos de celdas con ciclo For?

Deseándote un excelente año, por favor tu ayuda:

1- Necesito concatenar:

B2 "-" E1
B2 "-" F1
B2 "-" G1
B2 "-" ... Hasta V1

Posteriormente concatenar,
B43 "-" E42
B43 "-" F42
B43 "-" G42
B43 "-" ... Hasta V42

Y así consecutivamente hasta finalizar el ciclo de 41 filas.

2. Posterior al ciclo de concatenación ordenar de mayor a menor la columa K desde la tercera fila.

3. Poner un N° correlativo a partir de 1 y en función del orden de la columna K, es decir,:

- 1 para el primer grupo de la columna K
- 2 para el segundo grupo de la columna K
- Y así sucesivamente.

Este fue el código inicial con que me ayudaste, pero aún necesito incluir otras funciones:

Sub Datos()
'

     
      Application.ScreenUpdating = False
    Set h1 = Sheets("OC")
    Set h2 = Sheets("oferta_de_compra")
    '
    u = h2.Range("E" & Rows.Count).End(xlUp).Row
    If u = 2 Then u = 3
    h2.Range("E3:K" & u).ClearContents
    '
    n = 0
    For i = 3 To h1.Range("E" & Rows.Count).End(xlUp).Row
        For j = 5 To 52
            If h1.Cells(i, j) = "" Then Exit For
        Next
        '
        h1.Range(h1.Cells(i, "E"), h1.Cells(i, j)).Copy
        u2 = h2.Range("E" & Rows.Count).End(xlUp).Row + 1
        h2.Cells(u2, "E").PasteSpecial Paste:=xlPasteValues, Transpose:=True
        u3 = h2.Range("E" & Rows.Count).End(xlUp).Row ' ACA TERMINA EL CICLO PARA PEGAR LAS CURVAS
        h2.Range(h2.Cells(u2, "K"), h2.Cells(u3, "K")) = h1.Cells(i, "A") ' ACA SE PEGAN LAS TIENDAS
        h2.Range(h2.Cells(u2, "F"), h2.Cells(u3, "F")) = h1.Cells(i, "D") ' ACA SE PEGA EL PRECIO COSTO
        n = n + 1
        If n = 38 Then
            i = i + 3
            n = 0
        End If
    Next

Esta es la hoja OC:

Esta es la hoja Oferta_de_Compra:

1 Respuesta

Respuesta
1

Envíame tu archivo con las macros y con ejemplos, en una hoja me pones cómo tienes la información y en otra hoja pones cómo la quieres.

Recuerda poner tu nombre en el asunto del correo

[email protected]

Te anexo la macro con concatenar, ordenar, "IVA" y el consecutivo

Sub Datos()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set h1 = Sheets("OC")
    Set h2 = Sheets("oferta_de_compra")
    '
    u = h2.Range("E" & Rows.Count).End(xlUp).Row
    If u = 2 Then u = 3
    h2.Range("A3:M" & u).ClearContents
    '
    n = 0
    ren = 1
    For i = 3 To h1.Range("E" & Rows.Count).End(xlUp).Row
        If h1.Range("E" & i) = "" Then Exit For
        For j = 5 To 52
            If h1.Cells(i, j) = "" Then Exit For
        Next
        '
        j = j - 1
        h1.Range(h1.Cells(i, "E"), h1.Cells(i, j)).Copy
        u2 = h2.Range("E" & Rows.Count).End(xlUp).Row + 1
        h2.Cells(u2, "E").PasteSpecial Paste:=xlPasteValues, Transpose:=True
        u3 = h2.Range("E" & Rows.Count).End(xlUp).Row
        h2.Range(h2.Cells(u2, "K"), h2.Cells(u3, "K")) = h1.Cells(i, "A")
        h2.Range(h2.Cells(u2, "F"), h2.Cells(u3, "F")) = h1.Cells(i, "D")
        h2.Range(h2.Cells(u2, "M"), h2.Cells(u3, "M")) = "IVA"
        For m = 5 To j
            h2.Cells(u2, "C") = h1.Cells(ren + 1, "B") & "-" & h1.Cells(ren, m)
            u2 = u2 + 1
        Next
        n = n + 1
        If n = 38 Then
            ren = ren + 41
            i = i + 3
            n = 0
        End If
    Next
    u3 = h2.Range("E" & Rows.Count).End(xlUp).Row
    With h2.Sort
     .SortFields.Clear: .SortFields.Add Key:=h1.Range("K3:K" & u3)
     .SetRange h1.Range("A2:M" & u3): .Header = xlYes: .Apply
    End With
    '
    'consecutivo
    '
    u3 = h2.Range("E" & Rows.Count).End(xlUp).Row
    ant = h2.Cells(3, "K")
    conse = 1
    For i = 3 To u3
        If ant <> h2.Cells(i, "K") Then
            conse = conse + 1
        End If
        h2.Cells(i, "A") = conse
        ant = h2.Cells(i, "K")
    Next
    MsgBox "copiado terminado"
End Sub

Funciona perfecto!!!! muchas gracias Dante!!!

Dante! tengo un solo problema:

La macro no funciona si existen celdas vacías desde el rango "E:V"

La idea es que si esta vacía, pase a la siguiente y copie y traspase solo las celdas que tengan algún contenido.

Por favor tu ayuda!!

Muchas gracias.

Slds.

Podrías crear una nueva pregunta en todo expertos, ya que no estaba contemplada en tu petición original y tampoco lo mencionaste en los ejemplos. Si lo deseas, al final del título de la nueva pregunta puedes poner que va dirigida a Dante Amor.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas