Hola, hace algunos meses me ayudaron con esta macro:
Me ayudaron a crear una lista de empaque, evitando copiar y pegar el numero de cajas y sus especificaciones, lo que pasa es que cuando no completo la caja y queda 0.26 por ejemplo, no me aparece reflejada esa caja en la lista de empaque, solo cuando es arriba de 0.50. Me gustaría que aunque no se completará ni la mita de la caja, me pasará la caja completa la lista de empaque.
Anexo el código y el archivo en donde pueden manipular el pedido, en la ultima columna de CAJAS, aparecen según la cantidad que ustedes pongan.
Dim datos, i&, j&, k&, ped$, filas&, res
With b.Range("B4").CurrentRegion
datos = .Offset(1).Resize(.Rows.Count - 1)
ped = .Offset(1, 6).Resize(.Rows.Count - 1, 1).Address
End With
filas = Application.Sum(b.Range(ped))
ReDim res(1 To filas, 1 To 6)
For i = LBound(datos) To UBound(datos)
For j = 1 To datos(i, 7)
d = 1 + d
For k = 1 To 6
res(d, k) = datos(i, k)
Next k
Next j
Next i
With a.Range("B10")
.CurrentRegion.Offset(1).ClearContents
.Resize(filas, 6) = res
.CurrentRegion.Columns.AutoFit
End With
Hola, hace algunos meses me ayudaron con esta macro:
Me ayudaron a crear una lista de empaque, evitando copiar y pegar el numero de cajas y sus especificaciones, lo que pasa es que cuando no completo la caja y queda 0.26 por ejemplo, no me aparece reflejada esa caja en la lista de empaque, solo cuando es arriba de 0.50. Me gustaría que aunque no se completará ni la mita de la caja, me pasará la caja completa la lista de empaque.
Anexo el código y el archivo en donde pueden manipular el pedido, en la ultima columna de CAJAS, aparecen según la cantidad que ustedes pongan.
Dim datos, i&, j&, k&, ped$, filas&, res
With b.Range("B4").CurrentRegion
datos = .Offset(1).Resize(.Rows.Count - 1)
ped = .Offset(1, 6).Resize(.Rows.Count - 1, 1).Address
End With
filas = Application.Sum(b.Range(ped))
ReDim res(1 To filas, 1 To 6)
For i = LBound(datos) To UBound(datos)
For j = 1 To datos(i, 7)
d = 1 + d
For k = 1 To 6
res(d, k) = datos(i, k)
Next k
Next j
Next i
With a.Range("B10")
.CurrentRegion.Offset(1).ClearContents
.Resize(filas, 6) = res
.CurrentRegion.Columns.AutoFit
End With
Application.Goto a.Range("B11")
Erase datos, res
Proforma de prueba.xlsm