Macro para combinar hojas con filtros específicos

[darkyto]

Buenas necesitaría fusionar varias hojas cuyo nombre empiece por Seguimiento_ (sin fusionar las que estén ocultas aunque empiecen por ese nombre) y mostrar el resultado en una hoja que se llame Seguimiento_Anual, necesitaría que se ordenaran por la columna Cliente (de forma ascendente), por la columna Persona (de forma ascendente), por la columna Estado empezando por Enero, Febrero, Marzo y asi sucesivamente y por la columna Planificado (empezando por PLANIFICADO_Q1 y asi sucesivamente hasta el PLANIFICADOQ4. En caso de que ya exista la hoja Seguimiento_Anual que se actualicen los datos de esa hoja o bien se borre y se vuelva a crear.

Gracias un saludo. Hay ya macros creadas pero la de CombinarHojas es la que no funciona correctamente, adjunto una captura de como tendria que verse con los filtros aplicados en este caso puse un ejemplo con una hoja de seguimiento. Todas las hojas de seguimiento son iguales pero por trimestre cambian los meses de estado(3 meses por hoja de seguimiento)  y planificado (Cambia de PLANIFICADOQ1 a Q2 y asi hasta el 4).

  

Intente subir el excel pero pesa mas de 100 kb y por mucho que quite no consigo que llegue a ese peso.

Pego aqui la macro que tengo en este momento:

Sub CombinarHojas()
    Dim ws As Worksheet
    Dim wsDestino As Worksheet
    Dim lastRow As Long
    Dim rowCount As Long
    Dim header As Boolean
    Dim rng As Range
    Dim i As Long

    ' Eliminar hoja "Seguimiento_Anual" si ya existe
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("Seguimiento_Anual").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0

    ' Crear una nueva hoja para combinar los datos
    Set wsDestino = ThisWorkbook.Sheets.Add
    wsDestino.Name = "Seguimiento_Anual"

    rowCount = 1
    header = True ' Para copiar encabezados solo de la primera hoja

    ' Recorrer todas las hojas del libro
    For Each ws In ThisWorkbook.Worksheets
        ' Verificar si la hoja está visible y su nombre comienza con "Seguimiento_"
        If ws.Visible = xlSheetVisible And Left(ws.Name, 12) = "Seguimiento_" Then
            ' Encontrar la última fila con datos en la hoja
            lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

            If header Then
                ' Copiar encabezado y los datos (desde la fila 1 para la primera hoja)
                ws.Rows("1:" & lastRow).Copy Destination:=wsDestino.Cells(rowCount, 1)
                header = False
            Else
                ' Copiar solo los datos omitiendo la fila 1 (encabezado)
                ws.Rows("2:" & lastRow).Copy Destination:=wsDestino.Cells(rowCount, 1)
            End If

            ' Actualizar el número de filas en la hoja de destino
            rowCount = wsDestino.Cells(wsDestino.Rows.Count, "A").End(xlUp).Row + 1
        End If
    Next ws

    ' Recalcular la última fila en la hoja de destino
    lastRow = wsDestino.Cells(wsDestino.Rows.Count, "A").End(xlUp).Row

    ' Eliminar filas donde las columnas C, D, E, F y G estén vacías
    For i = lastRow To 2 Step -1 ' Comenzar desde la última fila hacia arriba
        If Application.WorksheetFunction.CountA(wsDestino.Cells(i, 3).Resize(1, 5)) = 0 Then
            wsDestino.Rows(i).Delete
        End If
    Next i

    ' Recalcular la última fila después de eliminar las filas vacías
    lastRow = wsDestino.Cells(wsDestino.Rows.Count, "A").End(xlUp).Row

    ' Establecer el rango para la ordenación
    Set rng = wsDestino.Range("A1:G" & lastRow)

    ' Ordenar los datos por las columnas A y B de manera ascendente
    wsDestino.Sort.SortFields.Clear
    wsDestino.Sort.SortFields.Add Key:=wsDestino.Range("A2:A" & lastRow), Order:=xlAscending
    wsDestino.Sort.SortFields.Add Key:=wsDestino.Range("B2:B" & lastRow), Order:=xlAscending

    ' Ordenar la columna E por meses en orden personalizado
    With wsDestino.Sort
        .SortFields.Add Key:=wsDestino.Range("E2:E" & lastRow), _
            SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="Enero24,Febrero24,Marzo24,Abril24,Mayo24,Junio24,Julio24,Agosto24,Septiembre24,Octubre24,Noviembre24,Diciembre24"
    End With

    ' Ordenar la columna F por cuatrimestres en orden personalizado
    With wsDestino.Sort
        .SortFields.Add Key:=wsDestino.Range("F2:F" & lastRow), _
            SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="PLANIFICADOQ1_2024,PLANIFICADOQ2_2024,PLANIFICADOQ3_2024,PLANIFICADOQ4_2024"
    End With

    ' Aplicar la ordenación
    With wsDestino.Sort
        .SetRange rng
        .header = xlYes
        .Apply
    End With
End Sub

 

 

[Israel Cassales]

Hola,

No me lo tome a mal pero más que ayuda parece una solicitud de servicio, creo si contacta con algún administrador éste le puede dar recomendaciones de cómo obtener soluciones personalizadas o esperar si (tal vez) alguno de los maestros o miembros avanzados del foro le puede aportar algo.

Si un poco de ayuda o recomendación le viene bien, le sugiero:

Haga una copia de su libro, hay ocasiones que prefieren subir el original para no editarlo. Inténtelo, para lo que menciona no necesita todos esos datos que lo hacen pesado.  Guárdelo como tipo binario, los códigos no le afectan.

Seccione su consulta, describa lo que ha hecho para lograr el resultado y en dónde le mostró errores en caso de presentarlos.

Que tenga un buen día, saludos cordiales.

Editado el el 8 de octubre por Israel Cassales

[JSDJSD]

Sube tu archivo