Macro to add worksheet

[Roy]

hi,all
I have a document that is 1 columns. I want add worksheets for example:
A1
sheet1
sheet1 sheet1
sheet8 ----->VBA add sheet sheet8
sheet8 sheet3
sheet3 ......
...... sheet4
sheet4

 

[Gary''s Student]

This little macro will run down the column and add a worksheet for each entry
that does not already have a worksheet:

Sub SheetAdder()
Set baseSheet = ActiveSheet
n = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To n
candidate = Cells(i, "A").Value
NoGood = False
For j = 1 To Sheets.Count
If Sheets(i).Name = candidate Then NoGood = True
Next
If Not NoGood Then
Sheets.Add
ActiveSheet.Name = candidate
baseSheet.Activate
End If
Next
End Sub

 

[Chip Pearson]

If you care about the order of the sheets (alpha ascending), try
either of the following. AAA puts the sheet directly in the
appropriate position. BBB always adds to the end and then sorts in
alpha ascending order.


Sub AAA()
Dim R As Range
Dim WS As Worksheet
Dim N As Long: N = 1
On Error Resume Next

For Each R In Worksheets("SHeet1").Range("A1:A10")
If Len(R.Text) > 0 Then
Err.Clear
Set WS = Nothing
Debug.Print R.Text, N
Set WS = ThisWorkbook.Worksheets(R.Text)
If Err.Number = 0 Then
N = WS.Index
Else
With ThisWorkbook.Worksheets
.Add(after:=.Item(N)).Name = R.Text
N = N + 1
End With
End If
End If
Next R
End Sub

Sub BBB()
Dim R As Range
Dim N As Long
Dim M As Long
Dim WS As Worksheet
On Error Resume Next

For Each R In Worksheets("Sheet1").Range("A1:A10")
If R.Text <> vbNullString Then
Err.Clear
Set WS = Nothing
Set WS = Worksheets(R.Text)
If Err.Number = 9 Then
ThisWorkbook.Worksheets.Add.Name = R.Text
End If
End If
Next R

' sort sheets
With Worksheets
For N = 1 To .Count
For M = N + 1 To .Count
If StrComp(.Item(M).Name, .Item(N).Name, vbTextCompare) >
0 Then
.Item(M).Move after:=.Item(N)
End If
Next M
Next N
End With
End Sub


Cordially,
Chip Pearson
Microsoft Most Valuable Professional,
Excel, 1998 - 2010
Pearson Software Consulting, LLC
www.cpearson.com