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