Thread: new sheet
View Single Post
  #1   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

This is working in the workbook you send me Steve
You have the names in Row 57

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

Set ws1 = ActiveSheet
For Each cell In ws1.Range("J57:IV57").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(cell.Column).Copy ws2.Range("A1")
ws2.Columns.AutoFit
Else
Set ws2 = Sheets(cell.Value)
Lc = Lastcol(ws2)
ws1.Columns(cell.Column).Copy ws2.Cells(1, Lc + 1)
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


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


"Ron de Bruin" wrote in message ...
Hi Steve

For example :
It will copy all columns with Dave in ws1.Range("B2:IV2") to the same sheet.

Send me a small test workbook private and I look at it for you

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


"steve" wrote in message ...
it's creating a seperate sheet for every column

"Ron de Bruin" wrote:

OK try this tester, copy the macro and both functions in a normal module.
Let me kmow if this is working for you

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

Set ws1 = ActiveSheet
For Each cell In ws1.Range("B2:IV2").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(cell.Column).Copy ws2.Range("A1")
ws2.Columns.AutoFit
Else
Set ws2 = Sheets(cell.Text)
Lc = Lastcol(ws2)
ws1.Columns(cell.Column).Copy ws2.Cells(1, Lc + 1)
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


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


"steve" wrote in message ...
thanks a lot man, i really appreciate it.

"Ron de Bruin" wrote:

Ahhaaaa

I will make a example for you this evening

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


"steve" wrote in message ...
yes, there are 3 salesmen, each one has about 30 jobs

"Ron de Bruin" wrote:

Hi Steve

Do you have duplicate names in row 2 ?

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


"steve" wrote in message ...
this code started creating a bunch of sheets. there's only 3 different
salesman. i need it to go through row 57 and filter out the salesman by
name. i should end up with three sheets.

thanks for your help ron


"Ron de Bruin" wrote:

Hi Steve

Try this one on a copy of your workbook

Sub test()
Dim WSNew As Worksheet
Dim Mysheet As Worksheet
Set Mysheet = ActiveSheet
For Each cell In Range("B2:IV2").SpecialCells(xlConstants)
Set WSNew = Worksheets.Add
On Error Resume Next
WSNew.Name = cell.Value
If Err.Number 0 Then
MsgBox "Change the name of : " & WSNew.Name & " manually"
Err.Clear
End If
Mysheet.Columns(cell.Column).Copy WSNew.Range("A1")
Next
End Sub


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


"steve" wrote in message ...
i did not create the worksheet i am working with. The data is organized so
the headings are by row, not column. For example:


A B C
1 Commision % 8.2 9.3
2 Sales Rep dave bill
3 Job # 1 2


I need to go through row 2, and make a sheet for each salesman. but it
needs to copy the whole column with it. most sheets are set up so these
would be the column headings. i don't want to reorganize the sheet by
transposing the data, but something like that could be hidden in the code if
need be. i'm stuck. so i'd appreciate any help.

THANKS,
Steve