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

Al seleccionar celda extraer sus dígitos automáticamente

Necesito dos favores, la idea es que al seleccionar una celda numérica de 4 dígitos del rango "af1;aj42" esta automáticamente extraiga sus cifras a la columna "a1, b1, c1, d1" como se muestra en la imagen Y lo segundo como puedo quitarle el msgbox a...
2 respuestas

Se puede agregar voz a Excel

Tengo una pantalla de vuelo de vuelo donde anotó despegues y arribos, Quiero que cada vez que se produzca un despegue y se agregue hora o aterrice alguno y se ponga la hora, excel diga o se escuche atención Aterrizaje o Atención despegue.
3 respuestas

Gráfico Comparativo por Semanas, en Power Bi.

Espero se encuentren muy bien. Tengo una tabla en Power BI con fechas, códigos, costos y cantidades. La necesidad que tengo es de crear un gráfico o tabla donde pueda comparar y analizar el comportamiento de los costos y las cantidades de un código...
1 respuesta

En una lista para pedidos tengo varios formularios

En una lista para pedidos con varios formularios la vengo usando desde hace tiempo sin ningún problema pero hace días la abrí para hacer un pedido y al pisar en el cuadro donde apunta la flecha para que me abra un otro cuadro donde coloco ciertos...
2 respuestas

Código VBA para crear un botón y guardar en PDF

Tengo un archivo word con 7 capturas, una en cada página (1-7), cual seria el código para crear un botón en la barra de herramientas de acceso rápido para convertir en PDF cada página. El resultado seria 7 pdf.
2 respuestas

Como evitar que se duplique un dato en la base de datos

Trato que al ingresar los datos a la base de datos si en la columna "B" DNI es una cifra que ya esta en dicha base me lo indique en un Msgbox "El Dato ya existe" Esta es la macro que tengo en el botón Aceptar Private Sub Aceptar_Click()...
2 respuestas

Detectar si he marcado Celda dentro de un Rango de Excel.

Tengo un Rango en Hoja Excel: RgoDatos >> $B$3:$V$39 Quiero detectar si la celda que selecciono está dentro de ese Rango Si no está que por omisión me marque B3.
1 respuesta

Desproteger un rango de celdas en una hoja protegida

Tengo una aplicación donde en una hoja se ponen comentarios automáticos con una macro, pero como hay celdas donde hay fórmulas las tengo bloqueadas y ocultas para que no se borren por error al usarla, tengo puesto el Unprotect en la macro por que si...
8 respuestas

Dato fecha ya existe en tabla

Como están estimados maestros. En formulario, tengo botón archivar. Envío información a hoja "existencias" a tabla "tbl_existencias". En columna A un Código desde textbox1 En columna B fecha desde textbox "txtFecha2" En columna C total desde textbox2...
2 respuestas

Enviar hoja activa al monitor secundario con vba

He creado una segunda ventana de mi hoja excel con NewWindow, y lo que pretendo es mediante código VBA enviarla al monitor secundario, lo he intentado con Application.SendKeys "^({ESC}+{RIGHT})", pero no lo consigo, con "^{ESC}" estoy tratando de...
2 respuestas