[duda]consolidar datos concretos de varias hojas

[dogwall]

Buenos días,

Tengo un libro con 13 hojas. Doce de ellas correspondientes a cada uno de los meses y una final (TOTALES) en las que necesito pegar los datos de esas doce hojas mensuales; todas tienen el mismo formato. Me encuentro con varios problemas:

De cada hoja mensual sólo necesito unas determinadas líneas, éstas vienen indicadas con el nombre del destino.

Sólo necesito copiar de cada una de las hojas mensuales los datos con los totales pero además necesito diferenciar en esa hoja TOTALES a qué mes corresponde cada dato. Añado fichero de ejemplo, con el resultado final en la hoja TOTALES, de cómo lo necesitaría.

En el ejemplo sólo he incluido dos meses, necesitaría consolidad los doce meses.

Muchas gracias.

SeguimientoMensual PAE.zip

[Antoni]

Prueba con esta macro:

Dim MESES() As String, Hoja As Worksheet

Dim TOT As Worksheet, Fila As Long, x As Long


Sub Consolidación()

Application.ScreenUpdating = False


ReDim MESES(12)

For x = 1 To 2: MESES(x) = UCase(MonthName(x)): Next


Set TOT = Sheets("TOTALES")

TOT.Range("3:" & TOT.Range("B" & Rows.Count).End(xlUp).Row + 1).ClearContents


Fila = 3

For Each Hoja In Sheets

  If Buscar(Hoja) = True Then

      For x = 12 To ActiveSheet.Range("C" & Rows.Count).End(xlUp).Row

        If Left(ActiveSheet.Range("C" & x), 5) = "Total" Then

            TOT.Range("B" & Fila) = UCase(ActiveSheet.Name)

            TOT.Range("C" & Fila) = ActiveSheet.Range("B" & x)

            TOT.Range("D" & Fila) = ActiveSheet.Range("C" & x)

            TOT.Range("E" & Fila) = ActiveSheet.Range("E" & x)

            TOT.Range("F" & Fila) = ActiveSheet.Range("G" & x)

            TOT.Range("G" & Fila) = ActiveSheet.Range("J" & x)

            TOT.Range("H" & Fila) = ActiveSheet.Range("M" & x)

            TOT.Range("I" & Fila) = ActiveSheet.Range("P" & x)

            TOT.Range("J" & Fila) = ActiveSheet.Range("Q" & x)

            TOT.Range("K" & Fila) = ActiveSheet.Range("T" & x)

            TOT.Range("L" & Fila) = ActiveSheet.Range("U" & x)

            Fila = Fila + 1

        End If

      Next

  End If

Next


TOT.Activate

End Sub


Function Buscar(Hoja As Worksheet) As Boolean

Buscar = False

For x = 1 To 12

  If MESES(x) = UCase(Hoja.Name) Then

      Hoja.Activate

      Buscar = True

      Exit Function

  End If

Next

End Function

[/CODE]

[dogwall]

Muchas gracias. Lo he probado justo antes de marcharme y creo que ha funcionado correctamente. En el primer For te has comido un 1 delante del 2:

For x = 1 To 2: pero creo que me sirve. Me queda añadir el encabezado a esa tabla TOTALES, creo que sabré hacerlo sin excesivos problemas.

Te agradecería que me explicases un poco el código (si no es inconveniente).

Y ya una última cuestión: si el número de hojas fuese distinto a 12, supongamos que en lugar de tener en el libro del 2014 tengo varios años con sus respectivos meses. ¿Cómo se haría? Se podría comprobar de forma dinámica la cantidad de hojas creadas en el fichero?

Gracias por tu ayuda.

[Antoni]

Efectivamente, hay que cambiar el bucle For x = 1 To 2 por For x = 1 to 12, recuerda que solo habías subido datos de Enero y Febrero.

En cuanto a la otra cuestión, es evidente que habría que distinguir las hojas del mismo mes entre un año y otro.

¿ Pero habría un único resumen con todas las hojas o un resumen con las hojas de cada año. ?

Respóndeme a esta cuestión y me pienso una solución.

[dogwall]

Pues mi idea es tener todo en una sola hoja, y con esos datos generar gráficos. Siempre desde esa hoja. No se si es más efectivo nombrar las hojas con el año+mes (2014_ENERO) y de ahí sacar el dato del año y mes para distinguir en la tabla TOTALES o cómo.

A lo mejor mi planteamiento no es del todo correcto y es mejor totalizar por años... No lo se. Pero mi idea inicial era meter todo en una sola tabla TOTALES.

Muchas gracias.

[Antoni]

.

Nombra las hojas de acuerdo a tu propuesta:

Año_Nombre del mes

He añadido el año en la columna A de la hoja TOTALES.

Aquí tienes la macro corregida.

Dim MESES() As String, Hoja As Worksheet

Dim TOT As Worksheet, Fila As Long, x As Long


Sub Consolidación()

Application.ScreenUpdating = False


ReDim MESES(12)

For x = 1 To 2: MESES(x) = UCase(MonthName(x)): Next


Set TOT = Sheets("TOTALES")

TOT.Range("3:" & TOT.Range("B" & Rows.Count).End(xlUp).Row + 1).ClearContents


Fila = 3

For Each Hoja In Sheets

  If Buscar(Hoja) = True Then

      For x = 12 To ActiveSheet.Range("C" & Rows.Count).End(xlUp).Row

        If Left(ActiveSheet.Range("C" & x), 5) = "Total" Then

            TOT.Range("A" & Fila) = Left(ActiveSheet.Name, 4)

            TOT.Range("B" & Fila) = UCase(Mid(Hoja.Name, 6))

            TOT.Range("C" & Fila) = ActiveSheet.Range("B" & x)

            TOT.Range("D" & Fila) = ActiveSheet.Range("C" & x)

            TOT.Range("E" & Fila) = ActiveSheet.Range("E" & x)

            TOT.Range("F" & Fila) = ActiveSheet.Range("G" & x)

            TOT.Range("G" & Fila) = ActiveSheet.Range("J" & x)

            TOT.Range("H" & Fila) = ActiveSheet.Range("M" & x)

            TOT.Range("I" & Fila) = ActiveSheet.Range("P" & x)

            TOT.Range("J" & Fila) = ActiveSheet.Range("Q" & x)

            TOT.Range("K" & Fila) = ActiveSheet.Range("T" & x)

            TOT.Range("L" & Fila) = ActiveSheet.Range("U" & x)

            Fila = Fila + 1

        End If

      Next

  End If

Next


TOT.Activate

End Sub


Function Buscar(Hoja As Worksheet) As Boolean

Buscar = False

For x = 1 To 12

  If MESES(x) = UCase(Mid(Hoja.Name, 6)) Then

      Hoja.Activate

      Buscar = True

      Exit Function

  End If

Next

End Function

[/CODE]

[dogwall]

Muchas gracias. Mañana pruebo y te comento.

[dogwall]

Probado y todo perfecto. Funciona sin problemas.

Muchas gracias por tu ayuda. Puede cerrarse el tema.