Name a Worksheets

[rock_001]

Hi,

I have a excel sheet with names in range (A2:A11).

1. I'm looking for a vb script that creates a new excel sheet on my desktop.
2. The worksheets in the workbook should be named from the range i have in the excel.
3. Its not defined that i have 10 names in the range each time, so the macro should count and create the worksheets & should not create extra worksheets.

Appreciate your help in advance.

 

[pedie]

Dim ws As Worksheet, i As Long
Set ws = ActiveSheet
For i = 2 To 11
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = ws.Range("A" & i).Value
Next i

Link for more

 

[hiker95]

rock_001,


I assume that the worksheet where the new worksheet names are located is Sheet1.

If your list contains special characters not permitted by the system for worksheet names you will get an message, and that cell in Sheet1 will be colored with a red background.

Sample data in Sheet1 before the macro:

Excel Workbook
	A
1
2	a
3	b
4	c
5	:|/?*[]
6	d
7
8
9
10
11
12
Sheet1

After the macro:

Excel Workbook
	A
1
2	a
3	b
4	c
5	:|/?*[]
6	d
7
8
9
10
11
12
Sheet1

And workheets a, b, c, and d have been created.




Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Adding the Macro
1. Copy the below macro, by highlighting the macro code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub AddSheets()
' hiker95, 11/14/2010, ME508807
Dim w1 As Worksheet, ws As Worksheet
Dim c As Range
Application.ScreenUpdating = False
Set w1 = Worksheets("Sheet1")
For Each c In w1.Range("A2:A11")
  If c <> "" Then
    On Error Resume Next
    If Not Evaluate("ISREF(" & c.Value & "!A1)") Then Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = c.Value
    Set ws = ActiveSheet
    If Err Then
      w1.Cells(c.Row, 1).Interior.ColorIndex = 3
      MsgBox "Not able to create a new worksheet with the name '" & c.Value & "'!"
      Application.DisplayAlerts = False
      ws.Delete
      Application.DisplayAlerts = True
    End If
    On Error Resume Next
  End If
Next c
w1.Activate
Application.ScreenUpdating = True
End Sub

Then run the AddSheets macro.

 

[rock_001]

Thanks for your help Pedie & Hiker95..

Have a blessed day..