Copy sheet name to same cell on each sheet, 50 sheets; run code onany worhseet beforedoubleclick
 

I'm using Excel 2000 (yes ancient, I know).

I have a workbook with about 50 worksheets, I would like to copy the
name of each worksheet to the A5 cell of each sheet, and if possible
make it large bold text. Is there a way to automate that using a macro
so I don't have to do it manually?

Also I have a list of worksheet names in the A column, I wrote a simple
subroutine (below) to open a worksheet when the matching text is
double-clicked. Is there a way to make this code work on all 50 sheets
without copying the code to each worksheet manually?

I am not too fluent with VBA, thanks!

Mike

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
Dim strSheetName As String
strSheetName = Trim(Target.Value)
If Trim(Target.Value) = "" Then Exit Sub
Worksheets(strSheetName).Activate
End Sub

SOLVED: Copy sheet name to same cell on each sheet, 50 sheets; runcode on any worhseet beforedoubleclick
 

On 4/3/2016 3:41 PM, Mike S wrote:
I'm using Excel 2000 (yes ancient, I know).

I have a workbook with about 50 worksheets, I would like to copy the
name of each worksheet to the A5 cell of each sheet, and if possible
make it large bold text. Is there a way to automate that using a macro
so I don't have to do it manually?

Also I have a list of worksheet names in the A column, I wrote a simple
subroutine (below) to open a worksheet when the matching text is
double-clicked. Is there a way to make this code work on all 50 sheets
without copying the code to each worksheet manually?

I am not too fluent with VBA, thanks!

Mike

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
Dim strSheetName As String
strSheetName = Trim(Target.Value)
If Trim(Target.Value) = "" Then Exit Sub
Worksheets(strSheetName).Activate
End Sub

I found these pages
https://support.microsoft.com/en-us/kb/142126
http://analysistabs.com/excel-vba/wr...orksheet-cell/

and came up with this code.

Sub WorksheetLoop()
Dim WS_Count As Long, n As Long
On Error GoTo errorhandler
WS_Count = ActiveWorkbook.Worksheets.Count
For n = 1 To WS_Count
Worksheets(Worksheets(n).Name).Activate
DoEvents
Worksheets(n).Range("A5").Value = Worksheets(n).Name
Worksheets(n).Range("A5").Font.Bold = True
Worksheets(n).Range("A5").Font.Size = 12
DoEvents
Next
Exit Sub
'
errorhandler:
MsgBox Err.Number & " " & Err.Description
End Sub

SOLVED: Copy sheet name to same cell on each sheet, 50 sheets; run code on any worhseet beforedoubleclick
 

Perhaps simply...

Sub Insert_Sheetname()
Dim n&
On Error GoTo errorhandler
For n = 1 To ActiveWorkbook.Sheets.Count
With Sheets(n).Range("A5")
.Value = Sheets(n).Name: .Font.Bold = True: .Font.Size = 12
End With
Next

NormalExit:
Exit Sub

errorhandler:
MsgBox Err.Number & " " & Err.Description
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

SOLVED: Copy sheet name to same cell on each sheet, 50 sheets;run code on any worhseet beforedoubleclick
 

On 4/3/2016 5:45 PM, GS wrote:
Perhaps simply...

Sub Insert_Sheetname()
Dim n&
On Error GoTo errorhandler
For n = 1 To ActiveWorkbook.Sheets.Count
With Sheets(n).Range("A5")
.Value = Sheets(n).Name: .Font.Bold = True: .Font.Size = 12
End With
Next

NormalExit:
Exit Sub

errorhandler:
MsgBox Err.Number & " " & Err.Description
End Sub

Yes much cleaner, thanks.