S
scott
I am trying to add subtotals to for each worksheet in a workbook, but it
only runs once. I tried to call the sub routine rather than putting
the code in, but that didn't work either. i.e.
Sub workbookformat()
Dim wks As Worksheet
For Each wks In ThisWorkbook.Worksheets
call addsubtotals
next sks
end sub
Here is the more detailed code.
Sub workbookformat()
Dim wks As Worksheet
Dim startcell As Range
Dim lastrow As Integer
Dim colcount As Integer
For Each wks In ThisWorkbook.Worksheets
lastrow = ActiveSheet.Cells(65000, "a").End(xlUp).Row
lastcol = ActiveSheet.Cells(1, 255).End(xlToLeft).Column
colcount = lastcol - 15 'Total columns -15 columns of cust info
Set startcell = Cells(lastrow + 1, 15)
startcell.Select
For i = 1 To colcount
Selection.Offset(0, 1).Select
With Selection
.Formula = "=sum(" & Range(Selection.Offset(-1, 0),
Selection.End(xlUp).End(xlUp)).Address(False, False) & ")"
End With
'Add top and bottom borders
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
'.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Next i
Next wks
End Sub
Anyhelp would be appreciated.
Scott
only runs once. I tried to call the sub routine rather than putting
the code in, but that didn't work either. i.e.
Sub workbookformat()
Dim wks As Worksheet
For Each wks In ThisWorkbook.Worksheets
call addsubtotals
next sks
end sub
Here is the more detailed code.
Sub workbookformat()
Dim wks As Worksheet
Dim startcell As Range
Dim lastrow As Integer
Dim colcount As Integer
For Each wks In ThisWorkbook.Worksheets
lastrow = ActiveSheet.Cells(65000, "a").End(xlUp).Row
lastcol = ActiveSheet.Cells(1, 255).End(xlToLeft).Column
colcount = lastcol - 15 'Total columns -15 columns of cust info
Set startcell = Cells(lastrow + 1, 15)
startcell.Select
For i = 1 To colcount
Selection.Offset(0, 1).Select
With Selection
.Formula = "=sum(" & Range(Selection.Offset(-1, 0),
Selection.End(xlUp).End(xlUp)).Address(False, False) & ")"
End With
'Add top and bottom borders
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
'.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Next i
Next wks
End Sub
Anyhelp would be appreciated.
Scott