Inserta fila en la parte superior
Tengo una macro que me inserta filas en la parte de abajo pero requiero que me inserte una fila para inserta encabezados
'
Dim unicos As New Collection
Set datos = Range("a2").CurrentRegion
With datos
For i = 1 To .Rows.Count
partida = .Cells(i, 1)
On Error Resume Next
unicos.Add partida, CStr(partida)
On Error GoTo 0
Next i
For j = 1 To unicos.Count
partida = unicos.Item(j)
cuenta = WorksheetFunction.CountIf(.Columns(1), partida)
fila = WorksheetFunction.Match(partida, .Columns(1), 0)
Set AREA = .Rows(fila).Resize(cuenta, .Columns.Count)
With AREA
.Rows(.Rows.Count + 1).Resize(4).EntireRow.Insert
.Rows(.Rows.Count + 1).HorizontalAlignment = xlGeneral
.Rows(.Rows.Count + 1).VerticalAlignment = xlBottom
.Rows(.Rows.Count + 1).WrapText = False
.Rows(.Rows.Count + 1).Font.Bold = True
.Cells(.Rows.Count + 1, 37) = "SUB TOTAL FACTURA "
.Cells(.Rows.Count + 1, 38) = WorksheetFunction.Sum(.Columns(2))
.Cells(.Rows.Count + 1, 38).NumberFormat = "0,0.00"
.Rows(.Rows.Count + 1).HorizontalAlignment = xlGeneral
.Cells(.Rows.Count + 2, 37) = "IVA"
.Cells(.Rows.Count + 2, 38) = "=R[-1]C*0.16"
.Cells(.Rows.Count + 2, 38).NumberFormat = "0,0.00"
.Cells(.Rows.Count + 3, 37) = "TOTAL FACUTURA"
.Cells(.Rows.Count + 3, 38) = "=R[-2]C+R[-1]C"
.Cells(.Rows.Count + 3, 38).NumberFormat = "0,0.00"
'.Rows(.Rows.Count + 1).Resize(1).EntireRow.FillUp.Insert
'.Cells(.Rows.Count - 1, 0) = "ORD/TRAB "
.EntireColumn.AutoFit
End With
Next j
End With
1 Respuesta
Supongo que el encabezado que quieres que aparezca es ord/trab y que aparezca así
entonces esta es la modificacion que le hice a tu macro
Sub tezt()
Dim unicos As New Collection
Set datos = Range("a2").CurrentRegion
With datos
Range("ak:am").ClearContents
.Sort key1:=Range(.Columns(1).Address), order1:=xlAscending
For i = 1 To .Rows.Count
partida = .Cells(i, 1)
On Error Resume Next
unicos.Add partida, CStr(partida)
On Error GoTo 0
Next i
For j = 1 To unicos.Count
partida = unicos.Item(j)
cuenta = WorksheetFunction.CountIf(.Columns(1), partida)
fila = WorksheetFunction.Match(partida, .Columns(1), 0)
Set area = .Rows(fila).Resize(cuenta, .Columns.Count)
With area.Rows(area.Rows.Count + 1)
.Resize(4).EntireRow.Insert
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Font.Bold = True
End With
With area
.Cells(.Rows.Count + 1, 37) = "SUB TOTAL FACTURA "
.Cells(.Rows.Count + 2, 37) = "IVA"
.Cells(.Rows.Count + 3, 37) = "TOTAL FACTURA"
.Cells(.Rows.Count + 1, 38) = WorksheetFunction.Sum(.Columns(2))
.Cells(.Rows.Count + 2, 38) = "=R[-1]C*0.16"
.Cells(.Rows.Count + 3, 38) = "=R[-2]C+R[-1]C"
.Rows(.Rows.Count + 1).HorizontalAlignment = xlGeneral
.Cells(.Rows.Count + 1, 38).Resize(3, 1).NumberFormat = "$0,0.00"
.Cells(.Rows.Count + 1, 37).CurrentRegion.EntireColumn.AutoFit
If j = 1 Then .Rows(1).EntireRow.Insert
If j > 1 Then .Rows(0).EntireRow.Insert
.Cells(0, 1) = "ORD/TRAB "
.Cells(0, 1).Font.Bold = True
.EntireColumn.AutoFit
End With
Next j
End With
End Sub
