JSDJSD

Ahora mirando veo que ya te han dado solución en el foro amigo

Elimina datos innecesarios y sube tu archivo

El archivo Cambio de formatos.xlsm

La segunda es que te modifique cuando modificas cualquier celda de la columna A sin tener que ejecutar la macro manualmente. Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range Set rng = Intersect(Target, Me.Columns("A")) If rng Is Nothing Then Exit Sub Application.EnableEvents = False Call Poneformat Application.EnableEvents = True End Sub Sub Poneformat() Application.ScreenUpdating = False With Sheets("Plantilla") For i = 17 To .Range("A" & Rows.Count).End(xlUp).Row .Cells(i, "G").ClearFormats Select Case .Cells(i, "A") Case "SI" .Cells(i, "G").Font.Color = RGB(1, 70, 99) .Cells(i, "G").Font.Bold = True 'negrita .Cells(i, "O").Font.Color = RGB(100, 110, 0) .Cells(i, "F") = "-" Case "I" .Cells(i, "G").Font.Color = RGB(1, 701, 99) .Cells(i, "G").Font.Bold = True 'negrita Case "D" .Cells(i, "G").Font.Color = RGB(1, 170, 99) End Select Next i End With Application.ScreenUpdating = True End Sub

Te dejo dos opciones primera: Cambia tu macro por esta modificas las celdas de la columna a y ejecutas la macro Sub Poneformat() Application.ScreenUpdating = False With Sheets("Plantilla") For i = 17 To .Range("A" & Rows.Count).End(xlUp).Row .Cells(i, "G").ClearFormats Select Case .Cells(i, "A") Case "SI" .Cells(i, "G").Font.Color = RGB(1, 70, 99) .Cells(i, "G").Font.Bold = True 'negrita .Cells(i, "O").Font.Color = RGB(100, 110, 0) .Cells(i, "F") = "-" Case "I" .Cells(i, "G").Font.Color = RGB(1, 701, 99) .Cells(i, "G").Font.Bold = True 'negrita Case "D" .Cells(i, "G").Font.Color = RGB(1, 170, 99) End Select Next i End With End Sub

Private Sub CommandButton1_Click() With Hoja1 For x = 5 To .Range("B" & Rows.Count).End(xlUp).Row totalHoras = 0 horaEntradaAnterior = .Cells(x, 2) For i = 0 To 6 If .Cells(x, 2 + i * 2) <> "" And .Cells(x, 3 + i * 2) <> "" Then horaEntradaAnterior = .Cells(x, 2 + i * 2) horaSalidaActual = .Cells(x, 3 + i * 2) If horaSalidaActual < horaEntradaAnterior Then totalHoras = totalHoras + 24 + (Hour(horaSalidaActual) _ - Hour(horaEntradaAnterior)) Else totalHoras = totalHoras + (horaSalidaActual _ - horaEntradaAnterior) End If End If Next i If totalHoras > 40 Then .Cells(x, 16) = 40 .Cells(x, 17) = totalHoras - 40 Else .Cells(x, 16) = totalHoras .Cells(x, 17) = 0 End If Next x End With End Sub horas.xlsm

Sube tu archivo

Quieres que solamente lo haga en la fila 5 o en todas ?

No me queda claro te dejo una prueba a ver si es esto, teniendo en cuenta la jornada laboral de 40 horas semanales si calculamos la primera fila daría como resultado 40 hora y 37 extra, de no ser esto sube un ejemplo de como debería quedar en la primera fila

Private Sub FILTRAR_Click() Dim hojadatos As Worksheet Dim columna As Range Dim ultimafila As Long Dim dato As Variant Set hojadatos = ThisWorkbook.Sheets("IVASOPORTADO") Set columna = hojadatos.Columns("H") ActiveSheet.ListObjects("CLIENTES").Range.AutoFilter Field:=9, Criteria1:="10.00" ultimafila = Hoja5.Range("b" & Rows.Count).End(xlUp).Row dato = hojadatos.Cells(ultimafila, 9).Value txt_suma21 = dato End Sub Con esta modificación de tu código hace lo que supone que necesitas. Pero que pasa si quieres filtrar por un tipo de iva distinto? habría que estructurarlo de diferente forma.

With Me.ComboBox1 .Clear .List = Array("Elemento 1", "Elemento 2", "Elemento 3") End With Supongo que es esto lo que buscas ¡¡

Creo que necesitas explicarte mejor, pon un ejemplo de lo que tienes y como tiene que quedar en ambas situaciones

Cambia tu código del botón Grabar datos por este, a ver si es lo que buscas Private Sub CommandButton1_Click() Dim ufh24 As Long With Hoja24 ufh24 = .Range("A" & Rows.Count).End(xlUp).Row + 1 .Cells(ufh24, 1) = Application.WorksheetFunction.Max(.Columns(1)) + 1 .Cells(ufh24, 2) = CDate(TextBox3) .Cells(ufh24, 3) = ComboBox2 .Cells(ufh24, 4) = ComboBox3 .Cells(ufh24, 6) = TextBox4 .Cells(ufh24, 7) = CDbl(TextBox1) .Cells(ufh24, 8) = CDbl(ComboBox4) .Cells(ufh24, 9) = CDbl(ComboBox5) .Cells(ufh24, 10) = ComboBox6 .Cells(ufh24, 11) = CDbl(TextBox2) End With Limpiar End Sub

Private Sub CommandButton1_Click(): Application.ScreenUpdating = False With Hoja1 .Range("G:G").AdvancedFilter 2, , .Range("A3"), 1 For x = 4 To .Range("A" & Rows.Count).End(xlUp).Row empresa = Cells(x, 1) With Hoja1.Range("C2").CurrentRegion .AutoFilter 5, empresa ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count) ActiveSheet.Name = empresa .SpecialCells(12).Copy Sheets(empresa).Range("A1") .AutoFilter End With Next x .Columns(1).Clear End With End Sub Modelo 1.xlsm

Hola a ambos, te dejo una posible solución

No, pon lo que tú veas

La próxima abres un tema nuevo

Sería interesante añadir un formulario para poder seleccionar las hojas de seguimiento de las que quieres hacer el informe, ya que si en tu archivo tienes de varios años por ejemplo de 2023 y 2024 el informe te lo hará de todas las hojas que comiencen por la palabra Seguimiento independientemente si son de 2023 o 2024 con el formulario se solucionaría tal problemilla. Ahora mismo lo tienes para que seleccione solamente los del año 2024. En caso de que te aprueben dicha solución dímelo y te lo paso.

Sub FUSION(): Application.ScreenUpdating = False Application.DisplayAlerts = False Dim hoja As Worksheet Dim cabecera As Boolean Dim ufh2 As Long Dim tbl As ListObject Dim rng As Range Dim uf As Long Dim uc As Long On Error Resume Next: Sheets("FUSION").Delete: On Error GoTo 0 ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count) ActiveSheet.Name = "FUSION" cabecera = False For Each hoja In Sheets If hoja.Name Like "Seguimiento" & "*" & 24 Then If hoja.ListObjects.Count = 0 Then Else Set tbl = hoja.ListObjects(1) Set rng = tbl.Range tbl.Unlist End If ufh2 = Sheets("FUSION").Range("E" & Sheets("FUSION").Rows.Count).End(xlUp).Row + 1 If Not cabecera Then hoja.Range("A1:E1").Copy Destination:=Sheets("FUSION").Range("A1") cabecera = True End If With hoja.Range("A1").CurrentRegion .AutoFilter 4, Criteria1:="<>" .Offset(1).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(xlCellTypeVisible).Copy Sheets("FUSION").Range("A" & ufh2) .AutoFilter End With uf = hoja.Cells(hoja.Rows.Count, "A").End(xlUp).Row uc = hoja.Cells(1, hoja.Columns.Count).End(xlToLeft).Column Set rng = hoja.Range("A1").Resize(uf, uc) Set tbl = hoja.ListObjects.Add(xlSrcRange, rng, , xlYes) tbl.TableStyle = "TableStyleMedium2" End If Next Sheets("FUSION").Range("A:E").Columns.AutoFit MsgBox "Los datos se han actualizado correctamente en la hoja 'FUSION'." End Sub Ponlo en el modulo1 y prueba. El problema que tenias es que en el fichero anterior la macro se ejecutaba sobre un rango de datos y en tu archivo original tienes tablas dinámicas

Por cierto esta línea puedes eliminarla de la macro, no es necesaria Sheets("FUSION").Range("A2").Resize(Sheets("FUSION").Rows.Count - 1).Offset(0, 0).Delete

Sube un ejemplo de como debería quedar según los archivos subidos en mediafire