I think this covers everything
Sub ColForm()
Dim LR As Long
Application.ScreenUpdating = False
LR = Range("G" & Rows.Count).End(xlUp).Row
Columns("AD:AD").Clear
Range("AD12:AD" & LR - 1).Value = "1"
Range(Cells(LR, 7), Cells(LR, 29)).Clear
Cells(LR, 7).Formula = "=SUM(G$12:INDEX(G:G,MATCH(9.99999E+307,$AD:$AD)))"
Cells(LR, 7).AutoFill Destination:=Range(Cells(LR, 7), Cells(LR, 29)), Type:=xlFillDefault
Cells(8, 12).Formula = "=SUM($G$12:INDEX($AC:$AC,MATCH(9.99999E+307,$AD:$AD)))"
Cells(2, 12).Formula = "=SUM(G$12:INDEX(G:G,MATCH(9.99999E+307,$AD:$AD)))"
Cells(3, 12).Formula = "=SUM(W$12:INDEX(W:W,MATCH(9.99999E+307,$AD:$AD)))"
Cells(4, 12).Formula = "=SUM(H$12:INDEX(H:H,MATCH(9.99999E+307,$AD:$AD)))"
Cells(5, 12).Formula = "=SUM(I$12:INDEX(I:I,MATCH(9.99999E+307,$AD:$AD)))"
Cells(6, 12).Formula = "=SUM(J$12:INDEX(J:J,MATCH(9.99999E+307,$AD:$AD)))"
With Range(Cells(LR, 7), Cells(LR, 29))
.Font.Name = "Calibri"
.Font.FontStyle = "Regular"
.Font.Size = 9
.Font.ColorIndex = 1
.HorizontalAlignment = xlRight
.VerticalAlignment = xlTop
.NumberFormat = "#,##0.00"
End With
Range("A1:C1").Select
Application.ScreenUpdating = True
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
or possibly just
Sub ColForm2()
Dim LR As Long
Application.ScreenUpdating = False
LR = Range("G" & Rows.Count).End(xlUp).Row
Range("AD12:AD" & LR).Clear
Range("AD12:AD" & LR - 1).Value = "1"
Range(Cells(LR, 7), Cells(LR, 29)).ClearContents
Cells(LR, 7).Formula = "=SUM(G$12:INDEX(G:G,MATCH(9.99999E+307,$AD:$AD)))"
Cells(LR, 7).AutoFill Destination:=Range(Cells(LR, 7), Cells(LR, 29)), Type:=xlFillDefault
Cells(8, 12).Formula = "=SUM($G$12:INDEX($AC:$AC,MATCH(9.99999E+307,$AD:$AD)))"
Cells(2, 12).Formula = "=SUM(G$12:INDEX(G:G,MATCH(9.99999E+307,$AD:$AD)))"
Cells(3, 12).Formula = "=SUM(W$12:INDEX(W:W,MATCH(9.99999E+307,$AD:$AD)))"
Cells(4, 12).Formula = "=SUM(H$12:INDEX(H:H,MATCH(9.99999E+307,$AD:$AD)))"
Cells(5, 12).Formula = "=SUM(I$12:INDEX(I:I,MATCH(9.99999E+307,$AD:$AD)))"
Cells(6, 12).Formula = "=SUM(J$12:INDEX(J:J,MATCH(9.99999E+307,$AD:$AD)))"
Range("A1:C1").Select
Application.ScreenUpdating = True
ActiveWorkbook.Save
ActiveWorkbook.Close
End Subb
Bookmarks