Create Sheets Based on Cell Contents... 1

[tweek312]

Trying to write this code...

Its supposed to create sheets based on the contents of the cell O5 and keep going until the blank cell.

Please help! Whats wrong with my code?

Thanks,

tw33k

Sub mk_shts()

Dim ws As Worksheet 'Create a worksheet object
Set ws = Sheets.Add  'set worksheet Object to new sheet

Range("O5").Select 'selects the start cell
Do Until ActiveCell.Value = ""

Set ws = Sheets.Add  'set worksheet Object to new sheet
ws.Name = ActiveCell.Value  'rename sheet

ActiveCell.Offset(1, 0).Select

Loop

End Sub

 

[PHV]

You have to qualify Range("O5").

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[tweek312]

How do I do that?

 

[PHV]

The unambiguous way:
Workbooks("workbook name").Sheets("sheet name").Range("O5")

The problem with your code is that you select the O5 cell of the just created sheet ...

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[Zathras]

Alternatively, you could use something like this:

Sub AddSheets()
Dim oNameList As Range
Dim c As Range

  Set oNameList = Range("O5", Range("O5").End(xlDown))
  For Each c In oNameList
    Worksheets.Add.Name = c.Text
  Next c
  Set oNameList = Nothing
  
End Sub

This will not work correctly if cell O6 is blank. If that is a possibility, then code would be needed to test for that special case.

 

[tweek312]

Thanks Zathras! Ur Code works great!

I modified it just a bit:

Sub AddSheets()
Dim oNameList As Range
Dim c As Range

If Range("O6") = "" Then
  Set oNameList = Range("O5", Range("O5"))
  Else
  Set oNameList = Range("O5", Range("O5").End(xlDown))
End If
  
  For Each c In oNameList
    Worksheets.Add.Name = c.Text
  Next c
  Set oNameList = Nothing
  
End Sub