Hola, tengo esta macro que da formato a un reporte en excel, pero aun no me queda al 100 tiene algunos errores cuando separa las lineas que son diferentes aveces no lo hace, supongo que la validacion esta mal, y el encabezado aun no se como insertarlo, adjunto los archivos de antes(como se genera el reporte antes de la macro) y despues(como debe quedar) espero me puedan apoyar ya que soy nuevo en esto, Gracias

Sub eliminartotal()

' Seleccionar celda A2, *primera línea de datos*.

Range("A2").Select

' Configurar el bucle Do para que se detenga al llegar a una celda vacía.

Do Until IsEmpty(ActiveCell)

' Inserte el código aquí.

ActiveCell.SpecialCells(xlLastCell).Select

Rows(ActiveCell.Row).Delete

' Bajar 1 fila de la ubicación actual.

ActiveCell.Offset(-1, -7).Select

If ActiveCell.Value = "Total" Then

Rows(ActiveCell.Row).Delete

End If

Loop

Call limpiar

End Sub


Sub limpiar()

Range("A:Z").Select

Selection.Interior.Color = RGB(255, 255, 255)

ActiveSheet.Range("C:E", ActiveSheet.Range("C:E").End(xlDown)).Delete

Range("A1:E1").Interior.Color = RGB(54, 96, 146)

Range("A1:E1").Font.Color = RGB(255, 255, 255)

'color al fondo

Range("a1").Select

ActiveSheet.Cells.Select

Cells.EntireColumn.AutoFit

'Columns("E:E").Select

'Selection.ColumnWidth = 42

Cells.EntireRow.AutoFit

Call formato

End Sub


Sub formato()

' Seleccionar celda A2, *primera línea de datos*.

Range("A2").Select

' Configurar el bucle Do para que se detenga al llegar a una celda vacía.

Do Until IsEmpty(ActiveCell)

' Inserte el código aquí.

' Bajar 1 fila de la ubicación actual.

ScreenUpdating = False

FirstItem = ActiveCell.Value

SecondItem = ActiveCell.Offset(1, 0).Value

Offsetcount = 1

If FirstItem <> SecondItem And SecondItem <> "" Then

ActiveCell.Offset(Offsetcount, 0).Select

Selection.EntireRow.Insert shift:=xlDown

Range("A1:E1").Copy

ActiveSheet.Range("a2").End(xlDown).Offset(1, 0).PasteSpecial xlPasteAll

Application.CutCopyMode = False

Offsetcount = Offsetcount + 1

SecondItem = ActiveCell.Offset(Offsetcount, 0).Value

ElseIf ActiveCell <> "" Then

ActiveCell.Offset(Offsetcount, 0).Select

FirstItem = ActiveCell.Value

SecondItem = ActiveCell.Offset(1, 0).Value

Offsetcount = 1

End If

ScreenUpdating = True

ActiveCell.Offset(1, 0).Select

Loop

Call total

End Sub


Sub total()

' Seleccionar celda A2, *primera línea de datos*.

Range("A2").Select

Do Until IsEmpty(ActiveCell)

' Configurar el bucle Do para que se detenga al llegar a una celda vacía.

ScreenUpdating = False

FirstItem = ActiveCell.Value

SecondItem = ActiveCell.Offset(1, 0).Value

Offsetcount = 1

If FirstItem <> SecondItem And SecondItem = "Línea de pedido" Then

ActiveCell.Offset(Offsetcount, 0).Select

Selection.EntireRow.Insert shift:=xlDown

Offsetcount = Offsetcount + 1

SecondItem = ActiveCell.Offset(Offsetcount, 0).Value

ActiveCell.Offset(1, 0).Select

ElseIf ActiveCell <> "" Then

ActiveCell.Offset(Offsetcount, 0).Select

FirstItem = ActiveCell.Value

SecondItem = ActiveCell.Offset(1, 0).Value

Offsetcount = 1

End If

ScreenUpdating = True

ActiveCell.Offset(1, 0).Select

Loop

Call sumRangoImpresiones

End Sub


Sub sumRangoImpresiones()

Dim cellIni$, cellFin$, varSuma

Range("C2").Select 'Esta celda corresponde a la primera fila de tu tabla de valores

Do Until IsEmpty(ActiveCell) And IsEmpty(ActiveCell.Offset(1, 0))

'cellIni = Activecell.Select

cellIni = ActiveCell.Address 'Nos posiscionamos en la primera fila de valores

Do

If IsEmpty(ActiveCell) = False Then

ActiveCell.Offset(1, 0).Select

End If

Loop Until IsEmpty(ActiveCell) = True

cellFin = ActiveCell.Offset(-1, 0).Address 'Localizamos la ultima fila de valores de la tabla

varSuma = Range(cellIni, cellFin) 'Asignamos el rango a sumar

With ActiveCell.Offset(0, 0) 'Efectuamos la suma y le damos un poco de formato a la celda

.Value = Application.WorksheetFunction.Sum(varSuma)

.Font.Bold = True

.Font.Size = 10

'Sum = 0

With ActiveCell.Offset(0, -1)

.Value = "Total"

.Font.Bold = True

.Font.Size = 10

End With

End With

ActiveCell.Offset(2, 0).Select

Loop

Call sumRangoClicks

End Sub


Sub sumRangoClicks()

Dim cellIni$, cellFin$, varSuma

Range("D2").Select 'Esta celda corresponde a la primera fila de tu tabla de valores

Do Until IsEmpty(ActiveCell) And IsEmpty(ActiveCell.Offset(1, 0))

'cellIni = Activecell.Select

cellIni = ActiveCell.Address 'Nos posiscionamos en la primera fila de valores

Do

If IsEmpty(ActiveCell) = False Then

ActiveCell.Offset(1, 0).Select

End If

Loop Until IsEmpty(ActiveCell) = True

cellFin = ActiveCell.Offset(-1, 0).Address 'Localizamos la ultima fila de valores de la tabla

varSuma = Range(cellIni, cellFin) 'Asignamos el rango a sumar

With ActiveCell.Offset(0, 0) 'Efectuamos la suma y le damos un poco de formato a la celda

.Value = Application.WorksheetFunction.Sum(varSuma)

.Font.Bold = True

.Font.Size = 10

End With

ActiveCell.Offset(2, 0).Select

Loop

End Sub[/CODE]

ArchivoAntes.xls

ArchivoDespues.xls

Hola, esta consulta es diferente a la del otro post?

Pendiente - Macro para sumar de 1 a n rangos variables | Ayuda Excel