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