|
new sheet
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 |
new sheet
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 |
new sheet
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 |
new sheet
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 |
new sheet
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 |
new sheet
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 |
new sheet
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 |
new sheet
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 |
new sheet
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 |
new sheet
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 |
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 |
| All times are GMT +1. The time now is 03:19 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com