Saltar al contenido
Te enseño 7 de los trucos que me permitieron trabajar 2 horas menos al día >>>

[duda]consolidar datos concretos de varias hojas

dogwall

Recommended Posts

dogwall Principiante

dogwall

publicado
publicado

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 Veterano

Antoni

publicado
publicado

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 Principiante

dogwall

publicado
  • Autor
publicado

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 Veterano

Antoni

publicado
publicado

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 Principiante

dogwall

publicado
  • Autor
publicado

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 Veterano

Antoni

publicado
publicado

.

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]

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

Ir al listado de temas

  • 109 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

    1. 1. ¿Te parecen útiles los tips de las funciones?


      • Sí
      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Mantenimiento de la comunidad
      Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR

  • Archivos

  • Estadísticas de descargas

    • Archivos
      187
    • Comentarios
      97
    • Revisiones
      29
    Más información sobre "Un juego del Rabino en Excel"
    Última descarga
    Un juego del Rabino en Excel
    Por pegones1

    2    1

  • Crear macros Excel

  • Mensajes

    • Tilin2023
      FORMULA MACRO PARA QUE LA FORMULA SIEMPRE TOME LA ULTIMA FILA Y COLUMNA DE UNA TABLA A PESAR QUE AUMENTE

      Por Tilin2023 · publicado

      Adjunto excel CONTADOR FINAL.xlsb
    • Tilin2023
      FORMULA MACRO PARA QUE LA FORMULA SIEMPRE TOME LA ULTIMA FILA Y COLUMNA DE UNA TABLA A PESAR QUE AUMENTE

      Por Tilin2023 · publicado

      Buenos días,  espero se encuentren bien de salud compañeros, Favor me podrían ayuda con lo siguientes como se podría hacer cuando tengo una tabla dinámica que  amedida que se aumente las columnas fechas con data un formula que se coloco al final busque o analice siempre la ultima fila y columna de la fecha. Coloco un ejemplo
    • Tilin2023
      COMO ELIMINAR FILAS CON FECHA QUE NO APARECEN AL SIGUIENTE DIA

      Por Tilin2023 · publicado

      @JSDJSD Excelentes, GRACIAS POR TU SOPORTE , me ayudo demasiado es exactamente lo que quería. 5 ESTRELLAS
    • JSDJSD
      COMO ELIMINAR FILAS CON FECHA QUE NO APARECEN AL SIGUIENTE DIA

      Por JSDJSD · publicado

      'Opción 1 Sub FiltrarSKUPorFecha(): Application.ScreenUpdating = False Dim ultimaFila As Long, fila As Long Dim diccionarioSKU As Object Dim listaEliminar As Object Dim fechaActual As String, fechaSiguiente As String Dim f As Variant With Sheets("Consolidado") ultimaFila = .Cells(.Rows.Count, 1).End(xlUp).Row ' Crear diccionarios para comparar SKU y almacenar filas a eliminar Set diccionarioSKU = CreateObject("Scripting.Dictionary") Set listaEliminar = CreateObject("Scripting.Dictionary") ' Recorrer desde la primera fila hasta la penúltima For fila = 2 To ultimaFila - 1 fechaActual = .Cells(fila, 1).Value fechaSiguiente = .Cells(fila + 1, 1).Value ' Solo comparar la fecha actual con la siguiente (inmediatamente superior) If fechaActual <> fechaSiguiente Then diccionarioSKU.RemoveAll ' Limpiar el diccionario antes de llenarlo ' Guardar los SKU de la fecha siguiente (solo de la siguiente) For f = fila + 1 To ultimaFila If .Cells(f, 1).Value <> fechaSiguiente Then Exit For diccionarioSKU(.Cells(f, 2).Value) = 1 Next f ' Revisar los SKU de la fecha actual y marcar los que deben eliminarse For f = fila To 2 Step -1 If .Cells(f, 1).Value <> fechaActual Then Exit For ' Solo eliminar si el SKU no está en la fecha siguiente If Not diccionarioSKU.exists(.Cells(f, 2).Value) Then listaEliminar(f) = 1 ' Marcar fila para eliminar después End If Next f ' Ya no es necesario seguir buscando después de comparar la primera y la siguiente fecha Exit For End If Next fila ' Eliminar las filas marcadas sin afectar el bucle principal For Each f In listaEliminar.keys .Rows(f).Delete Next End With MsgBox "Completado correctamente.", vbInformation End Sub 'Opción 2 Sub FiltrarSKUPorFecha1(): Application.ScreenUpdating = False Dim ultimaFila As Long, fila As Long Dim listaEliminar As Collection Dim fechaActual As String, fechaSiguiente As String Dim f As Variant, i As Long Dim SKUExiste As Boolean With Sheets("Consolidado") ultimaFila = .Cells(.Rows.Count, 1).End(xlUp).Row ' Inicializar la colección para marcar las filas a eliminar Set listaEliminar = New Collection ' Recorrer desde la primera fila hasta la penúltima For fila = 2 To ultimaFila - 1 fechaActual = .Cells(fila, 1).Value fechaSiguiente = .Cells(fila + 1, 1).Value ' Solo comparar la fecha actual con la siguiente (inmediatamente superior) If fechaActual <> fechaSiguiente Then ' Revisar los SKU de la fecha actual y marcar los que deben eliminarse For f = fila To 2 Step -1 If .Cells(f, 1).Value <> fechaActual Then Exit For ' Comprobar si el SKU está en la fecha siguiente SKUExiste = False For i = fila + 1 To ultimaFila If .Cells(i, 1).Value <> fechaSiguiente Then Exit For If .Cells(i, 2).Value = .Cells(f, 2).Value Then SKUExiste = True Exit For End If Next i ' Si el SKU no se encuentra en la fecha siguiente, marcar para eliminar If Not SKUExiste Then listaEliminar.Add f ' Marcar fila para eliminar después End If Next f ' Ya no es necesario seguir buscando después de comparar la primera y la siguiente fecha Exit For End If Next fila ' Eliminar las filas marcadas sin afectar el bucle principal For Each f In listaEliminar .Rows(f).Delete Next f End With MsgBox "Completado correctamente.", vbInformation End Sub   TABLA ELIMINAR.xlsm
    • JSDJSD
      COMO ELIMINAR FILAS CON FECHA QUE NO APARECEN AL SIGUIENTE DIA

      Por JSDJSD · publicado

      Prueba y comenta 

  • Visualizado recientemente

    • No hay usuarios registrado para ver esta página.
×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.