Crear una hoja x cada subtotal

He escrito el siguiente código, que creo que hace más o menos lo que necesitas:


Sub prueba()
Dim rngV As Range, rngA As Range, wksH As Worksheet

With Worksheets("Hoja1") 'Hoja donde están los subtotales
.Outline.ShowLevels RowLevels:=2
Set rngV = .[A1].SpecialCells(xlCellTypeVisible)
For Each rngA In rngV.Areas
If rngA.Row <> 1 Then 'Se Supone que la fila 1 es de títulos
Set wksH = Worksheets.Add(, Worksheets(.Parent.Worksheets.Count))
wksH.Name = Replace(.Range("A" & rngA.Row), "Total ", "")
.Rows(1).Copy Destination:=wksH.[A1] 'Copiar la fila de títulos a la nueva hoja
.Range(Replace(Right(.Range("B" & rngA.Row).Formula, Len(.Range("B" & rngA.Row).Formula) - InStr(.Range("B" & rngA.Row).Formula, ",")), ")", "")).EntireRow.Copy Destination:=wksH.[A2]
wksH.Cells.RemoveSubtotal
End If
Next rngA
End With

Set wksH = Nothing
Set rngA = Nothing
Set rngV = Nothing
End Sub


pero el problema es que el código exacto dependerá de cómo tengas los datos, así que he subido un ejemplo con el código funcionando a http://www.excelsp.com/ejemplos/eje...41116a.xls para que puedas adaptarlo.

Tendrás que descargar el libro porque el código no funcionará si se intenta ejecutar desde Internet Explorer.
Un saludo.


Fernando Arroyo
MS MVP - Excel



"BLACIO" escribió en el mensaje news:

Saludos a toda la comunidad
>>Tengo una base de datos de un tamaño considerable, y hago subtotales por cada cuenta (aproximadamente 150 cuentas),
>>Existe la posibilidad de crear una hoja por cada subtotal o cuenta, de manera sistematizada???
>si la hay me va hacer de mucha ayuda
de antemando muchas gracias