Goedemorgen, ik probeer al een tijdje om de subtotalen (de hele rij) vetgedrukt te krijgen maar het wil maar niet lukken. Kan iemand mij een richting geven hoe ik dit voor elkaar krijg. (wat ik geprobeerd heb onder Selection.Subtotal is o.a. Rows(1).Font.Bold=True) maar dat werkt dus niet.....?
Code:
Sub Workbook_open()
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Sheets("calculations").Select
Cells.Select
ActiveSheet.Paste
Range("A1").Select
Dim l As Long
For l = Range("A" & Rows.Count).End(xlUp).Row To 3 Step -1
If Range("A" & l).Value <> Range("A" & l - 1).Value Then
Rows(l).Insert
End If
Next
Range("A1").Select
ActiveWindow.SmallScroll Down:=60
Range("A1:Q100").Select
ActiveWindow.SmallScroll Down:=-75
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(5, 7, 8, 9, 10 _
, 11, 12), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Range("A1").Select
ActiveWindow.SmallScroll Down:=57
Range("A1:Q100").Select
Selection.Copy
Sheets("CI & PL").Select
Range("A7").Select
ActiveSheet.Paste
Columns("G:G").Select
Selection.ColumnWidth = 10.57
Columns("B:B").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
Columns("N:N").EntireColumn.AutoFit
Columns("O:O").EntireColumn.AutoFit
Columns("P:P").EntireColumn.AutoFit
Columns("Q:Q").EntireColumn.AutoFit
Columns("B:B").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("B7").Select
Selection.Copy
Range("A7").Select
ActiveSheet.Paste
Range("A7").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "CTN nr."
Range("A1").Select
'kopieer blad naar nieuw leeg bestand
ActiveSheet.Copy
ThisFile = Range("G3").Value
ActiveWorkbook.SaveAs Filename:=ThisFile
fileSaveName = Application.GetSaveAsFilename( _
fileFilter:="Files (*.xls), *.xls")
If fileSaveName <> False Then
MsgBox "Save as " & fileSaveName
End If
ThisWorkbook.Close Savechanges:=False
End Sub