Implementación de código en vba

Alguno de los expertos que me pueda colaborar con la implementación de este código?

Option Explicit
'Modificado por Fernando mamani Blas

'
Private Sub CommandButton1_Click()
'
Dim C As Range, firstCell As Long
Application.ScreenUpdating = False
On Error GoTo err_CreaDetalle
Application.GoTo Sheets("Detalle").[a1]
On Error GoTo err_UnKnown
With ActiveSheet
.[a:que].EntireColumn.Delete
Intersect([a1].CurrentRegion, [d:e]).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.[j1], Unique:=True
.[j2:k2].Delete xlShiftUp
For Each C In .Range(.[j2], .[j65536].End(xlUp))
With .[a65536].End(xlUp).Offset(4)
.Value = C & " " & C.Offset(, 1)
.Characters(Start:=1 + Len(C), Length:=50).Font.Size = 14
firstCell = 3 + .Row
End With
With [a1].CurrentRegion
AutoFilterMode = False
.Offset(1).AutoFilter Field:=4, Criteria1:=C
.Copy ActiveSheet.Range("a" & firstCell - 2)
End With
With .[a65536].End(xlUp).Offset(1, 5).Resize(, 3)
.Formula = "= SUM(" & ActiveSheet.Range("f" & firstCell, .Item(1).Offset(-1)).Address(True, False) & ")"
.Interior.ColorIndex = 4
End With
Next C
AutoFilterMode = False
.[i:que].EntireColumn.Delete: .[1:3].EntireRow.Delete: .[d:e].EntireColumn.Delete
.[b:h].EntireColumn.AutoFit: .[a1].ColumnWidth = 11
End With
Application.ScreenUpdating = True
Exit Sub
err_CreaDetalle:
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "Detalle"
Resume
err_UnKnown:
Application.ScreenUpdating = True
MsgBox Err.Description
End Sub

Mil Gracias!

Añade tu respuesta

Haz clic para o