Como realizar macro para concatenar rangos de celdas con ciclo For?
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.
Con la ayuda del experto Dante Amor quien muy amablemente me ayudo con el siguiente código,
pero aún necesito completar algunas cosas, este es el código que nuestro amigo me entrego, pero
incluirle 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:
Amigos
1 Respuesta
Te anexo la macro para concatenar, ordenar y poner la palabra "IVA"
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
MsgBox "copiado terminado"
End Sub
