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