Hi

Try this one:

Sub Summary_All_Worksheets_With_Formulas()
Dim Sh As Worksheet
Dim Newsh As Worksheet
Dim myCell As Range
Dim ColNum As Integer
Dim RwNum As Long
Dim Basebook As Workbook

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

'Delete the sheet "SummarySheet" if it exists
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Worksheets("SummarySheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name "SummarySheet"
Set Basebook = ThisWorkbook
Set Newsh = Basebook.Worksheets.Add
Newsh.Name = "SummarySheet"

'Add headers on row 2
Newsh.Range("B2:H2").Value = Array("Merchant Name", "", "Merchant ID",
"", "Profitability", "", "Residuals")

'The links to the first sheet will start in row 4
RwNum = 3

For Each Sh In Basebook.Worksheets
If Sh.Name < Newsh.Name And Sh.Visible Then
ColNum = 2
RwNum = RwNum + 1
'Create a link to the sheet in the B column
Newsh.Cells(RwNum, 2).Formula =
"=HYPERLINK(""#""&CELL(""address"",'" & Sh.Name & "'!A1)," _
& """" & Sh.Name & """)"
For Each myCell In Sh.Range("C3,T14,T15") '<--Change the
range
ColNum = ColNum + 2
Newsh.Cells(RwNum, ColNum).Formula = "='" & Sh.Name & "'!" &
myCell.Address(False, False)
Next myCell

End If
Next Sh

LastRow = Newsh.Range("F" & Rows.Count).End(xlUp).Row
Newsh.Range("F" & LastRow + 1) = "Totals"
Newsh.Range("H" & LastRow + 1).Formula = "SUM(H4:H" & LastRow & ")"
Newsh.UsedRange.Columns.AutoFit
Newsh.Columns("A,C,E,G").ColumnWidth = 2
Newsh.Range("1,3").RowHeight = 6
With Newsh.Range("1,3").Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With

With Newsh.UsedRange.Font
.Name = "Tahoma"
.Size = 12
End With

Newsh.UsedRange.Font.Bold = True
Range("F16").Select
ActiveCell.FormulaR1C1 = "Totals"
Range("H16").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-12]C:R[-1]C)"
Range("H17").Select

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = True
End With
End Sub

Regards,
Per

"KennyD" skrev i meddelelsen
...
I am new to VBA and can follow along fairly well, but don't know how to do
certain things. I have the following macro that runs like a champ, but
now I
need to automatically format the SummarySheet. Specifically, I need to
set
Columns A,C,E and G to a width of 2 and to have a color of Light Gray (in
Office 2010 it's White, Background 1, Darker 25%). I also need to set
Rows 1
and 3 to a height of 6 and have a color of Light Gray. Then I need to
change
the output font to Tahoma, 12, Bold. Finally, I have to have a cell at
the
bottom of Column F that says "Totals" and then sum all the values in
Column H
from H4 to the LastRow. Any help would be greatly appreciated.

Sub Summary_All_Worksheets_With_Formulas()
Dim Sh As Worksheet
Dim Newsh As Worksheet
Dim myCell As Range
Dim ColNum As Integer
Dim RwNum As Long
Dim Basebook As Workbook

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

'Delete the sheet "SummarySheet" if it exists
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Worksheets("SummarySheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True

'Add a worksheet with the name "SummarySheet"
Set Basebook = ThisWorkbook
Set Newsh = Basebook.Worksheets.Add
Newsh.Name = "SummarySheet"

'Add headers on row 2
Newsh.Range("B2:H2").Value = Array("Merchant Name", "", "Merchant ID",
"", "Profitability", "", "Residuals")

'The links to the first sheet will start in row 4
RwNum = 3

For Each Sh In Basebook.Worksheets
If Sh.Name < Newsh.Name And Sh.Visible Then
ColNum = 2
RwNum = RwNum + 1
'Create a link to the sheet in the B column
Newsh.Cells(RwNum, 2).Formula =
"=HYPERLINK(""#""&CELL(""address"",'" & Sh.Name & "'!A1)," _
& """" & Sh.Name & """)"
For Each myCell In Sh.Range("C3,T14,T15") '<--Change the
range
ColNum = ColNum + 2
Newsh.Cells(RwNum, ColNum).Formula = "='" & Sh.Name & "'!"
&
myCell.Address(False, False)
Next myCell

End If
Next Sh

Newsh.UsedRange.Columns.AutoFit

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = True
End With
End Sub
--
Nothing in life is ever easy - just get used to that fact.