Copiar hojas y nombrarlas, según el total de valores únicos, después llenarlas con la información de otra hoja.

Quisiera saber si me pueden ayudar, tengo una base de datos que alimento manualmente, a partir de esa información quiero crear una lista de valores únicos, que están en listados a partir de la celda A8, por ejemplo si son 20 valores diferentes quiero copiar una hoja dentro del libro llamada "FGen" el número total de valores diferentes (continuando con el ejemplo, 20 veces) dentro del mismo libro, y que su nombre sea la combinación de la información en la celda A más la celda B, colocando entre paréntesis la información de la celda B.

Una vez que se logre copiar las hojas, me gustaría llenarlas con la información que esta en mi base de datos, en el mismo libro, en la hoja llamada "Generador"

Me es muy difícil tratar de explicarlo, adjunto el archivo en cuestión, las hojas que están de color rojo, las hice manualmente, y es lo que quiero saber si se puede hacer con macros.

Archivo de información

1 respuesta

Respuesta
1

Espero te sirva esta macro. Solo tienes que tener en cuenta que en la Hoja Generador no tengas datos en las columnas X, Y, Z

Sub listas()

Application.ScreenUpdating = False

Sheets("Generador").Activate
Range("A7:A38").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("X1"), Unique:=True
Sheets("Generador").Activate
Columns("X:X").Select
Selection.AutoFilter
ActiveWorkbook.Worksheets("Generador").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Generador").AutoFilter.Sort.SortFields.Add Key _
:=Range("X1:X31"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("Generador").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Selection.AutoFilter

Range("Z2").FormulaLocal = "=SI(X2="""";"""";CONCATENAR(X2;""("";BUSCARV(X2;$A$8:$B$38;2;FALSO);"")""))"
Range("Z2").Select
Selection.AutoFill Destination:=Range("Z2:Z31")
Sheets.Add
ActiveSheet.Name = "Temp"
Sheets("Generador").Select
Range("A7").Select
Selection.AutoFilter
Range("X1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select

Set MyRing = Selection
Range("A1").Select
n = 0

For Each Mycell In MyRing
If Mycell.Value = "" Then GoTo fin:
ActiveSheet.Range("A:A").AutoFilter Field:=1, Criteria1:=Mycell
Name = Range("Z1").Offset(1 + n, 0).Value
Range("A8:K38").Copy Sheets("Temp").Range("A1")
Sheets("Temp").Select
filas = WorksheetFunction.CountA(Range("A1:A1000"))
If filas > 17 Then
Sheets("FGen").Select
Sheets("FGen").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Name
Sheets("Temp").Select
Range("A1:K17").Copy Sheets(Name).Range("D12")
Sheets("FGen").Select
Sheets("FGen").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Name & "(2)"
Sheets("Temp").Select
Range("A18:K34").Copy Sheets(Name & "(2)").Range("D12")
n = n + 1
Else
Sheets("FGen").Select
Sheets("FGen").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Name
Sheets("Temp").Select
Range("A1:K17").Copy Sheets(Name).Range("D12")
n = n + 1
End If

Sheets("Temp").Range("A1:K38").ClearContents
Sheets("Generador").Select
Selection.AutoFilter
Next

fin:

Application.DisplayAlerts = False
Sheets("Temp").Delete
Application.DisplayAlerts = True
Sheets("Generador").Select
Columns("X:Z").Delete

Application.ScreenUpdating = True

End Sub

Muy amable por responder, coloque el código en un Modulo, y me arroja lo siguiente. ¿ a que crees que se deba? 

Gracias!!!

¿Tienes la columna z oculta o protegida?

No, para nada, esta visible y desprotegida.

De hecho, te envió la hoja ya con el código insertado en un modulo, activo la macro mediante el botón que esta en la hoja Generador.

Hoja con la macro, prueba v2

Muy amable, gracias!

¿Lo puedes colgar en dropbox?

Archivo en dropbox

ya subí el archivo a DropBox, muchas gracias!

Te dejo el archivo en Dropbox.

https://www.dropbox.com/s/0wb62rgzyfhxad6/prueba%20final.xlsm?dl=0 

El problema estaba en que en la cabecera de la hoja Generador, tienes celdas combinadas.

He añadido una línea para evitar ese error

Gracias por responder, ya descargue el archivo, pero me marca el mismo error en el archivo descargado.

Supongo que debes tener la coma como separador en las fórmulas (yo tengo punto y coma)

Ya lo he cambiado para que te funcione

https://www.dropbox.com/s/c3fvnidabdh85db/prueba%20final%202.xlsm?dl=0 

Muy amable, funciona a la perfección, gracias en realidad no tenia idea de como programar ese código y menos en una sola macro, te lo agradezco. 

Hola, disculpa una ultima consulta, cuando las hojas a crear superan las dos, ya no me sigue creando más hojas aunque lo requiera, como en el ejemplo del archivo que te envió, en realidad son 35 conceptos, y en cada hoja caben 17, solamente crea dos hojas, no me crea la tercera, ¿sera posible que el número de hojas a crear supere las dos hojas? ya que realmente no tengo un limite establecido de hojas, pueden variar.

https://www.dropbox.com/s/2701hl5e7vzl5wb/prueba%20final%202.xlsm?dl=0 

de ante mano muchas gracias.

Lo he modificado para que te valga hasta 1000 elementos en la hoja Generador. Si necesitas más, solo tendrás que sustituir los 1000 por más en la macro.

Sub listas()

Application.ScreenUpdating = False

Sheets("Generador").Activate
Range("A8:A100").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("X1"), Unique:=True
Sheets("Generador").Activate
Columns("X:X").Select
Selection.AutoFilter
ActiveWorkbook.Worksheets("Generador").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Generador").AutoFilter.Sort.SortFields.Add Key _
:=Range("X1:X31"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("Generador").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Selection.AutoFilter
Range("Z2").FormulaLocal = "=SI(X2="""";"""";CONCATENAR(X2;""("";BUSCARV(X2;$A$9:$B$1000;2;FALSO);"")""))"
Range("Z2").Select
Selection.AutoFill Destination:=Range("Z2:Z31")
Sheets.Add
ActiveSheet.Name = "Temp"
Sheets("Generador").Select
Range("A7").Select
Selection.AutoFilter
Range("X1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select

Set MyRing = Selection
Range("A1").Select
n = 0

For Each Mycell In MyRing
If Mycell.Value = "" Then GoTo fin:
Selection.AutoFilter
ActiveSheet.Range("$A$8").AutoFilter Field:=1, Criteria1:=Mycell
Name = Range("Z1").Offset(1 + n, 0).Value
Range("A9:K1000").Copy Sheets("Temp").Range("A1")
Sheets("Temp").Select
filas = WorksheetFunction.CountA(Range("A1:A1000"))
n = n + 1
J = 1
w = 0
If filas > 17 Then
hojas = Int((filas / 17) + 1)
For i = 1 To hojas
Sheets("FGen").Select
Sheets("FGen").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Name & "(" & J & ")"
Sheets("Temp").Select
Range(Cells(1 + w, 2), Cells(17 + w, 11)).Copy Sheets(Name & "(" & J & ")").Cells(12, 2)
w = w + 17
J = J + 1
Next

Else
Sheets("FGen").Select
Sheets("FGen").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Name
Sheets("Temp").Select
Range("B1:K17").Copy Sheets(Name).Range("B12")
End If

Sheets("Temp").Range("A1:K1000").ClearContents
Sheets("Generador").Select
Selection.AutoFilter
Next

fin:

Application.DisplayAlerts = False
Sheets("Temp").Delete
Sheets("Generador").Select
ActiveSheet.ListObjects("Tgen").Range.AutoFilter Field:=1
Columns("X:Z").Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Un saludo

https://www.dropbox.com/s/tpshwcgkvqa9c6g/prueba%20final%203.xlsm?dl=0 

¡Gracias! Funciona correctamente, muy amable por toda tu ayuda.

Que estés bien.

Hola, nuevamente quisiera solicitar de nuevo tu amable ayuda.

Resulta que recorrí el margen de los conceptos para que pudieran imprimirse correctamente, de 17 los pase a 13, modifique muy poco la macro para lograr eso y funciono sin problemas. pero estuve tratando de colocar en la celda K25 el total de la hoja y, cuando sea la ultima hoja del concepto, sumar el total de las hojas anteriores, es decir si tenemos la siguientes hojas.

1(PR05615)(1) Aqui quisiera colocar en K25 el total del rango K12:K24 (Lo hago sin problemas con una suma).

1(PR05615)(2) Sin embargo, como esta es la ultima hoja de este "concepto", en vez de colocar el total, quisiera colocar la suma del K25 de la hoja 1(PR05615)(1) más la suma del K12:K24 de la hoja actual, en este ejemplo son solo dos hojas, pero el número de hojas es variable.

Otro comentario, es que el último concepto coloca la cantidad pero no el nombre. De nuevo te adjunto el archivo que contiene la macro y ahí trae otra breve explicación para ser más gráfico, espero puedas ayudarme.

https://www.dropbox.com/s/gsm5l4fx7xp86yi/prueba%20final%203.xlsm?dl=0  

Muchas gracias

Gabriel

Nuevas preguntas en nuevos hilos

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas