Hi Kevin,

First part

Dim sh As Worksheet

For Each sh In ActiveWorkbook.Worksheets
sh.Name = Replace(sh.Range("A4").Value, "Business ", "")
Next sh

Second part, an alternative suggestion, let them select from this dialog

Sub PrintSheets()
Const nPerColumn As Long = 35 'number of items per** column
Const nWidth As Long = 7 'width of each lette**r
Const nHeight As Long = 18 'height of each row
Const sID As String = "___WorksheetPrint" 'name of dialog* shee*t
Const kCaption As String = " Select worksheets to print"
'dialog caption


Dim i As Long
Dim TopPos As Long
Dim iBooks As Long
Dim cLeft As Long
Dim cCols As Long
Dim cLetters As Long
Dim cMaxLetters As Long
Dim iLeft As Long
Dim thisDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As CheckBox


Application.ScreenUpdating = False
If ActiveWorkbook.ProtectStructure Then
MsgBox "Workbook is protected.", vbCritical
Exit Sub
End If


On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.DialogSheets(sID).Delete
Application.DisplayAlerts = True
On Error GoTo 0
Set CurrentSheet = ActiveSheet
Set thisDlg = ActiveWorkbook.DialogSheets.Add


With thisDlg


.Name = sID
.Visible = xlSheetHidden


'sets variables for positioning on dialog
iBooks = 0
cCols = 0
cMaxLetters = 0
cLeft = 78
TopPos = 40


For i = 1 To ActiveWorkbook.Worksheets.Count


If i Mod nPerColumn = 1 Then
cCols = cCols + 1
TopPos = 40
cLeft = cLeft + (cMaxLetters * nWidth)
cMaxLetters = 0
End If


Set CurrentSheet = ActiveWorkbook.ActiveSheet
cLetters = Len(ActiveWorkbook.Worksheets(i).Name*)
If cLetters cMaxLetters Then
cMaxLetters = cLetters
End If


iBooks = iBooks + 1
.CheckBoxes.Add cLeft, TopPos, cLetters * nWidth*, 16.5
.CheckBoxes(iBooks).Caption = ActiveWorkbook.Wor*ksheets(i).Name
TopPos = TopPos + 13


Next i


.Buttons.Left = cLeft + (cMaxLetters * nWidth) + 24


CurrentSheet.Activate


With .DialogFrame
.Height = Application.Max(68, _
Application.Min(iBooks, nPerColumn) * nHeigh*t + 10)
.Width = cLeft + (cMaxLetters * nWidth) + 24
.Caption = kCaption
End With


.Buttons("Button 2").BringToFront
.Buttons("Button 3").BringToFront


Application.ScreenUpdating = True
If .Show Then
For Each cb In thisDlg.CheckBoxes
If cb.Value = xlOn Then
ActiveWorkbook.Worksheets(cb.Caption).Pr*intOut
End If
Next cb
Else
MsgBox "No sheets selected"
End If
Application.DisplayAlerts = False


.Delete


End With


End Sub





--

HTH

RP
(remove nothere from the email address if mailing direct)


"Kevin R" wrote in message
...
First I want to thank everyone for their help. I've received great
assistance in this group. I have several worksheets in a work book. As
it
is now, each sheet is named like Sheet1, Sheet2, and so on. Is there a
way
to use vba to rename each of these sheets so that it picks up the name
from
part of the text in a cell? For example, each worksheet has a specific
cell
(A4) that includes "Business: XYZ Company". I want to name the sheet with
what is in cell A4 minus the "Business: " leaving only XYZ Company. The
second part of this is that there are so many sheets that it would be nice
to
have vba prompt with an InputBox for a company name and then find that
sheet
with the same name entered into the InputBox, display it, and then
automatically print it. I've tried several different methods to
accomplish
both but haven't had any luck. Thanks.