Yes. I've done this before. My free Excel add-in
(www.grbps.com/adddin.htm) contains the facility to create new sheets
based on a range which is selected. It then turns these sheet names into
hyperlinks to open the new sheets. This is the code:
-------------------------------
Sub MakeNewSheet()
Dim strMain As String
Dim strAddress As String
Dim BadCharsCount As Integer
Dim DupeNameFlag As Boolean
On Error GoTo Err_MakeNewSheet
strMain = ActiveSheet.Name
For Each c In Selection
strAddress = c.Address
If Len(c.Value) = 0 Then
MsgBox "Empty cell at " & Replace(c.Address, "$", "")
Exit Sub
End If
If Len(c.Value) > 31 Then
MsgBox "Sheet name exceeds 31 characters at cell " &
Replace(c.Address, "$", "")
Exit Sub
End If
BadCharsCount = InStr(1, c.Value, ":") + _
InStr(1, c.Value, "\") + _
InStr(1, c.Value, "/") + _
InStr(1, c.Value, "?") + _
InStr(1, c.Value, "*") + _
InStr(1, c.Value, "[") + _
InStr(1, c.Value, "]")
If BadCharsCount > 0 Then
myAnswer = MsgBox("Illegal characters in proposed filename
at cell " & _
Replace(c.Address, "$", "") & "." & vbCrLf & "Do you
want me to fix it?", vbYesNo)
If myAnswer = vbNo Then
MsgBox "Halting execution at cell " & Replace(c.Address,
"$", "")
Exit Sub
End If
c.Value = Replace(c.Value, ":", "-")
c.Value = Replace(c.Value, "\", "-")
c.Value = Replace(c.Value, "/", "-")
c.Value = Replace(c.Value, "?", "-")
c.Value = Replace(c.Value, "*", "-")
c.Value = Replace(c.Value, "[", "-")
c.Value = Replace(c.Value, "]", "-")
End If
For Each d In Sheets
If c.Value = d.Name Then DupeNameFlag = True
Next d
If DupeNameFlag Then
MsgBox "Duplicate sheet name at cell " & Replace(c.Address,
"$", "")
Exit Sub
End If
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = c.Value
strSubAddr = "'" & c.Value & "'!A1"
Sheets(strMain).Hyperlinks.Add c, "", strSubAddr, "Go to sheet",
c.Value
strSubAddr = "'" & strMain & "'!" & strAddress
ActiveSheet.Hyperlinks.Add ActiveSheet.Range("a1"), "",
strSubAddr, "Back to index", "Main Sheet"
Sheets(strMain).Select
Next c
Err_MakeNewSheet:
End Sub
--------------------------
Of course, this isn't quite what you want to do. You need to create one
new sheet, then in column A list the names of all sheets in the file and
then in the next column lift your number from that sheet. This code will
do it for you:
--------------------------
Sub MakeSummrySheet()
Dim strMain As String
Dim strName As String
Sheets.Add Before:=Sheets(1)
ActiveSheet.Name = "Summary sheet"
Range("a1").Select
For Each c In Sheets
If c.Name <> "Summary sheet" Then
strName = c.Name
Selection.Value = c.Name
strMain = "='" & c.Name & "'!G10"
Selection.Offset(0, 1).Formula = strMain
Selection.Offset(1, 0).Select
End If
Next c
---------------------------
Simply replace the G10 reference with the cell which contains the total
on your sheets.