Need A macro to inseet new sheets with given names

[Dilusha]

I have following data in sheet1(Column A)
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]SSS
[/TD]
[/TR]
[TR]
[TD]SSS
[/TD]
[/TR]
[TR]
[TD]EXP
[/TD]
[/TR]
[TR]
[TD]KIK
[/TD]
[/TR]
[TR]
[TD]KIK
[/TD]
[/TR]
[TR]
[TD]KIK
[/TD]
[/TR]
[TR]
[TD]MIC
[/TD]
[/TR]
[TR]
[TD]SNS
[/TD]
[/TR]
[TR]
[TD]SNS
[/TD]
[/TR]
[TR]
[TD]TRF

[/TD]
[/TR]
</tbody>[/TABLE]

I want to insert new sheets by giving above names to same work book(only one sheet for one name. here 6 sheets ) . column A is sorted .
I use excel 2007 -in my lap top .
please help me .

 

[Peter_SSs]

See if this does what you want.

Sub Add_Sheets()
  Dim c As Range
  Dim ws As Worksheet
  
  With Sheets("Sheet1")
    For Each c In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
      On Error Resume Next
      Set ws = Sheets(c.Value)
      On Error GoTo 0
      If ws Is Nothing Then Sheets.Add.Name = c.Value
      Set ws = Nothing
    Next c
  End With
End Sub

Or you might want this for the line that adds the sheets

If ws Is Nothing Then Sheets.Add(After:=Sheets(Sheets.Count)).Name = c.Value

 

[Dilusha]

See if this does what you want.

Sub Add_Sheets()
  Dim c As Range
  Dim ws As Worksheet
  
  With Sheets("Sheet1")
    For Each c In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
      On Error Resume Next
      Set ws = Sheets(c.Value)
      On Error GoTo 0
      If ws Is Nothing Then Sheets.Add.Name = c.Value
      Set ws = Nothing
    Next c
  End With
End Sub

Or you might want this for the line that adds the sheets

If ws Is Nothing Then Sheets.Add(After:=Sheets(Sheets.Count)).Name = c.Value

it workes
thanks a lot

 

[Peter_SSs]

it workes
thanks a lot

You're welcome.