Hola. Buenas tardes a todos.

Ojalá me puedan ayudar como siempre.

Necesito generar tantas hojas como datos existan en el archivo adjunto.

Me explico, de una Base de Datos (BD) en donde se relacionan diferentes números de Ordenes de Trabajo (OT), debo de crear una hoja resumen por cada OT.

Es decir, en la columna "B", vienen los números de las OT usadas en esa BD.

Entonces, mediante un procedimiento crear una hoja que contenga todas las filas en donde se mencione "equis" numero de OT.

Si la BD contiene 8 o más Ordenes de trabajo, el procedimiento me debe de generar 8 hojas conteniendo la información de cada OT. Más la hoja Original.

No importa si las crea antes o despues de la hoja original.

En el archivo anexo, puse un par de ejemplos de lo que se requiere.

Hice algunas pruebas tomando algunos ejemplos del foro, pero no logro que se mantenga el formato de la hoja original.

Anexo el codigo que usé para ello, al cual lo adecue para mi archivo y lo tomé de una consulta añeja:

Además, este procedimiento funciona bien, pero no me da los Totales por OT.

Sub HojaPorOT()

Application.ScreenUpdating = False

Nombre = ActiveSheet.Name

Sheets(Nombre).Activate

Range("B21").Activate

While ActiveCell <> ""

ultf = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

x = 0

gestor = ActiveCell

While ActiveCell.Offset(x, 0) = gestor

x = x + 1

Wend

Range(ActiveCell, ActiveCell.Offset(x - 1, 39)).Copy

Sheets.Add.Name = ActiveCell

Range("B21").PasteSpecial

Range("B20:AO20").Value = Sheets(Nombre).Range("B20:AO20").Value

Range("B20").Activate

Sheets(Nombre).Activate

ActiveCell.Offset(x, 0).Activate

Wend

Application.ScreenUpdating = True

End Sub

Me pueden ayudar por favor...?

Saludos desde la Cd. De México, D.F.

NIPS AGO-13_frsc.zip

Hola Francisco, este ejemplo puede servirte:

HojaDepto.xls

Hola Armando

Gracias por tomarte la molestia de ver mi caso.

Ofrezco una disculpa por contestar hasta hoy en la mañana.

Ya utilicé el archivo que me facilitas. Trabaja bien.

Vienen dos procedimientos. Yo adecue los parametros del primero para que funcionara en mi archivo y...

1.-Al crear las hojas, no me respeta el Formato de la hoja original.

2.-Ni crea los Totales por cada columna con datos numericos.

3.-Me crea varias hojas en blanco cada vez que pasa por esta línea:

If wsheet Is Nothing Then Worksheets.Add().Name = wsname 'Doesn't exist

Me podrías orientar que sucede...?

Saludos.

Si subes tu ejemplo con el codigo incorporado lo adecuare.

Claro que si Armando. Con mucho gusto..!

Codigo usado

Sub Create_Sheet()

Dim wsheet As Worksheet

Set ws = ActiveSheet

For r = 21 To ws.Range("B65536").End(xlUp).Row

wsname = ws.Cells(r, 2)

On Error Resume Next

Set wsheet = Sheets(wsname)

If wsheet Is Nothing Then Worksheets.Add().Name = wsname 'aquie es donde creo está el problema

Set wsheet = Nothing

On Error GoTo 0

Set rs = Sheets(CStr(ws.Cells(r, 2)))

lrow = rs.Range("B65536").End(xlUp).Row + 1

rs.Cells(lrow, 1) = ws.Cells(r, 1)

rs.Range(rs.Cells(lrow, 2), rs.Cells(lrow, 39)).Value = ws.Range(ws.Cells(r, 2), ws.Cells(r, 39)).Value

Next r

ws.Activate

End Sub

Complementando la información, las hojas creadas deben de ser como las que vienen en el archivo, a un lado de la hoja "Original".

Muchas gracias

NIPS AGO-13_frscfrscfrsc.zip