Tengo una duda que requiero resolver, Copiar n hojas a un libro nuevo de acuerdo a cantidad definida en una variable en vba.
Paso a describir lo que requiero, tengo una lista de datos variable, las mismas salen de otra macro de autofiltro de 10 campos, que según una selección en una celda me muestra los códigos y detalles de productos asociados a esa marca, ejemplo FO para FORD, CH para CHEVROLET y así con otras n cantidad de marcas, eso está dominado mediante una macro, ahora bien, los datos mostrados en ese autofiltro son variables, es ejemplo FO tiene 10 registros en filas, desde la celda D6 hasta la D15, si aplico otro filtro para otra marca ejemplo CH tiene 1506 registros en el mismo rango, ¿qué hago con esos datos? A parte de quedarme ciego analizando, debo llenar una planilla de pedido que solo me acepta 20 códigos por planilla, en esto también lo tengo dominado mediante otra macro que cuenta desde abajo hasta arriba y me copia sin problemas en la planilla cuando la marca y la condición me muestran 20 códigos o menos, ahora como no me gusta la cosa tan simple, empieza la verdadera duda, cuando son mas de 20 códigos requiero la CantidadProductos/20, esto me da numero de hojas aplicando esta formula CantProdAux = Int(cantprod / 20) + 1, aqui no hay problemas, hasta aquí se cuantos códigos son, cuantas hojas requiero para meter de 20 en 20 esos códigos, Aquí esta la duda, ¿cómo hago para que se me copie CantProdAux veces el formato de pedido y que me copie de 20 en 20 en cada hoja y que cada hoja sea el numero de hoja de pedido?, ejemplo tengo 61 productos, esto me da 61/20 = 3.05 es decir 3 hojas y 1 celda, para corregir aplico Int(61/ 20) + 1, y me da 4 hojas. Aqui llevo este codigo
Sub pedidomay20()
Application.ScreenUpdating = False
Static F As Long
Dim a As Integer
Dim cont As Integer
Dim numhoja As Integer
Sheets("CONSULTA").Activate
Range("d6:d45000").Select 'selecciono la columna donde están los códigos
cantprod = (Range("d" & Rows. Count).End(xlUp). Row) - 5 'son 5 filas de nombres y formatos de tablas
If cantprod > 20 Then
CantProdAux = Int(cantprod / 20) + 1
MsgBox "se cargarán " & cantprod & " Productos en " & CantProdAux & " hojas de pedido" 'aviso la cantidad de productos y cant de hojas
Sheets("CONSULTA").Activate
For Fila = 6 To cantprod Step 20
ActiveSheet. Range(Cells(Fila, 11), Cells(Fila + 19, 11)).Select 'el primer codigo en la celda d6
Selection.Copy
Sheets("pedido").Activate 'nombre de hoja destino
Range("d39:d58").Select 'rango de pegado de codigos
ActiveSheet.Paste
Sheets("pedido").Select
Sheets("pedido").Copy
For numhoja = 1 To CantProdAux
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name , Name = numhoja
Next numhoja
Next Fila
End If
End Sub
2 Respuestas
Te anexo la macro, crea el pedido desde un código hasta n códigos.
Te crea una hoja por cada 20 códigos.
Prueba y me comentas
Sub Realizar_Pedido()
'Por.Dante Amor
Application.ScreenUpdating = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("CONSULTA")
Set h2 = l1.Sheets("pedido")
'
una = True
n = 1
For fila = 6 To h1.Range("D" & Rows.Count).End(xlUp).Row Step 20
If una Then
h2.Copy
Set l2 = ActiveWorkbook
una = False
Else
h2.Copy after:=l2.Sheets(l2.Sheets.Count)
End If
Set h21 = l2.ActiveSheet
h21.Name = n
h1.Range(h1.Cells(fila, 11), h1.Cells(fila + 19, 11)).Copy h21.Range("D39")
n = n + 1
Next
Application.ScreenUpdating = True
MsgBox "Se ha creado el pedido. Número de hojas : " & n - 1
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
Hola Gracias por tu pronta respuesta, en tu versión si se abre las n copias en el formato correspondiente y en otro libro todas juntas, perfecto, pero no se copian los códigos de los productos que están en la columna DE de la hoja consulta, y deben copiarse en a partir de la celda i39 hasta la i58 (me falto decirte eso) solo se copian los datos de la columna que, es decir la hoja pedido tiene esas solas variables (cant de pedido, y código del producto), luego con otra macro que ya funciona se imprime en pdf y el resto. ¿Qué debo modificar para hacerlo?
Sí, efectivamente te faltó comentar eso, ya que en tu macro solamente se copia la columna 11 "K"
Te anexo la macro con el cambio
Sub Realizar_Pedido()
'Por.Dante Amor
Application.ScreenUpdating = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("CONSULTA")
Set h2 = l1.Sheets("pedido")
'
una = True
n = 1
For fila = 6 To h1.Range("D" & Rows.Count).End(xlUp).Row Step 20
If una Then
h2.Copy
Set l2 = ActiveWorkbook
una = False
Else
h2.Copy after:=l2.Sheets(l2.Sheets.Count)
End If
Set h21 = l2.ActiveSheet
h21.Name = n
h1.Range(h1.Cells(fila, "D"), h1.Cells(fila + 19, "D")).Copy h21.Range("I39")
h1.Range(h1.Cells(fila, "K"), h1.Cells(fila + 19, "K")).Copy h21.Range("D39")
n = n + 1
Next
Application.ScreenUpdating = True
MsgBox "Se ha creado el pedido. Número de hojas : " & n - 1
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Prueba con esta macro y comentas
Sub COPIAR_HOJAS()
Set hc = Worksheets("CONSULTA"): Set hp = Worksheets("PEDIDO")
Set DATOS = hc.Range("D6").CurrentRegion
With DATOS
HOJAS = WorksheetFunction.Quotient(.Rows.Count, 20)
restos = .Rows.Count Mod 20
If restos = 0 Then HOJAS_TOT = HOJAS
If restos > 0 And restos < 20 Then HOJAS_TOT = HOJAS + 1
MsgBox ("SE GENERARAN " & HOJAS_TOT & " HOJAS"), vbInformation, "AVISO"
For i = 1 To HOJAS
If i = 1 Then Set veinte = hc.Range("K6").Resize(20, 1)
If i > 1 Then Set veinte = veinte.Rows(21).Resize(20, 1)
Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = hp.Name & "-0" & i
With Range("d39:d58")
.Value = veinte.Value
.Select
End With
Next i
If restos > 0 Then Set veinte = veinte.Rows(21).Resize(restos, 1)
Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = hp.Name & "-0" & i
With Range("d39").Resize(restos, 1)
.Value = veinte.Value
.Select
End With
End With
End Sub