new sheet

S

steve

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
 
R

Ron de Bruin

Hi Steve

You can do two things before you run the macro
Delete all sheets or Clear all data on each sheet in a seperate macro

Try this (it delete all sheets exept hidden sheets and your Sales sheet)

Sub delete_sheets()
Dim sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> "Sales" And sh.Visible = True Then
Application.DisplayAlerts = False
sh.delete
Application.DisplayAlerts = True
End If
Next
End Sub
 
S

steve

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.
 
R

Ron de Bruin

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top