Macro para insertar filas e igualar cantidades.
Paso 1:Tengo este archivo, la idea que que insertar filas de acuerdo a la cantidad. Por ejemplo si en "D2", me están solicitando 3 unidades, inserto dos filas mas y repito el numero 3 (3 para cada fila). Si para la posterior me pidieran 4, inserto 3 filas, mas la anterior y que se repita el mismo numero, 4.
Paso 2:En la columna N, debería ser el segregado, retomando el ejemplo de "D2" que me piden 3 unidades; entonces en el rango de N2 a N4, seria (1,2,3) ya que me piden 3 unidades. Si para la siguiente cantidad en 4, seria (1,2,3,4)
Paso3: El paso 3 seria rellenar las filas vacías.
1 respuesta
Te anexo la macro actualizada, según la imagen la cantidad está en la columna "D" y el número en la "N"
Sub IgualarCantidades()
'Por.Dante Amor
Application.ScreenUpdating = False
For i = Range("D" & Rows.Count).End(xlUp).Row To 2 Step -1
Cells(i, "N") = 1
If Cells(i, "D") > 1 Then
n = Cells(i, "D")
Rows(i).Copy
Rows(i + 1 & ":" & i + n - 1).Insert Shift:=xlDown
Range("D" & i & ":D" & i + n - 1) = 1
Range("N" & i & ":N" & i + n - 1).DataSeries Step:=1
End If
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Terminado", vbInformation
End SubSaludos.Dante Amor
Recuerda valorar la respuesta.
Estimado Dan, en la columna N si corre bien, como es la idea del correlativo. Pero en la columna DE, ya no debería segregarlo de 1, más bien repetir la cantidad. Por ejemplo en D2 piden 3, inserto dos filas más y repito el mismo numero. (Ver la foto).
Así dejo el archivo para imprimir etiquetas en Zebra.
Ojala puedas ayudarme. Te dejo unas fotitos de como seria, en DE y en N
Te anexo la macro actualizada
Sub IgualarCantidades()
'Por.Dante Amor
Application.ScreenUpdating = False
For i = Range("D" & Rows.Count).End(xlUp).Row To 2 Step -1
num = Cells(i, "D")
If Cells(i, "D") > 1 Then
Cells(i, "N") = 1
n = Cells(i, "D")
Rows(i).Copy
Rows(i + 1 & ":" & i + n - 1).Insert Shift:=xlDown
Range("D" & i & ":D" & i + n - 1) = num
Range("N" & i & ":N" & i + n - 1).DataSeries Step:=1
Else
Cells(i, "N") = Cells(i, "D")
End If
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Terminado", vbInformation
End Sub
