Thread: new sheet
View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Ron de Bruin Ron de Bruin is offline
external usenet poster
 
Posts: 11,123
Default new sheet

You can do it like this then Steve in one step

Sub delete_sheets()
Application.DisplayAlerts = False
Sheets(Array("Dan", "Mike", "Jeff", "Keith", "David")).delete
Application.DisplayAlerts = True
End Sub


--
Regards Ron de Bruin
http://www.rondebruin.nl


"steve" wrote in message ...
Ron,

Works perfect now. Thanks for all your help man. i modified it a little bit:

Sub delete_sheets()
Dim sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
If sh.Name = "Dan" Or sh.Name = "Mike" Or sh.Name = "Jeff" _
Or sh.Name = "Keith" Or sh.Name = "David" Then
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
End If
Next
End Sub

i validated the cells so these are the only options for salesman. that way,
if another sheet is created, this macro won't delete it.

Thanks again for all your help.

"steve" wrote:

ron was the man and helped me out by writing this code for me. it goes
through a row of salesman, and makes a new sheet for each salesman. there
are duplicate entries for salesman, so it just adds more columns to that
sheet if the name repeats. i just need one more thing. when it is run
twice, all of the columns are repeated again on each sheet. is it possible
for the sheets to be erased each time and replaced? here is the code:

Sub test()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Lc As Long

Set ws1 = ActiveSheet
For Each cell In ws1.Range("J58:IV58").SpecialCells(xlConstants)
If SheetExists(cell.Value) = False Then
Set ws2 = Sheets.Add
On Error Resume Next
ws2.Name = cell.Value
On Error GoTo 0

ws1.Columns(1).Copy ws2.Range("A1")
ws1.Columns(cell.Column).Copy ws2.Range("B1")
ws2.Range("A1").Value = Date
ws2.Columns.AutoFit
Else
Set ws2 = Sheets(cell.Value)
Lc = Lastcol(ws2)
ws1.Columns(cell.Column).Copy ws2.Cells(1, Lc + 1)
ws2.Range("A1").Value = Date
End If
Next
End Sub

Function Lastcol(sh As Worksheet)
On Error Resume Next
Lastcol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function


Function SheetExists(SName As String, _
Optional ByVal WB As Workbook) As Boolean
'Chip Pearson
On Error Resume Next
If WB Is Nothing Then Set WB = ThisWorkbook
SheetExists = CBool(Len(WB.Sheets(SName).Name))
End Function