| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
macro filter
Hi, can this macro be modified to save results in another sheets in the same
workbook? Now it's saving in many workbooks in "c:\temp\", but i need the results to be saved in sheets in the same workbook. Can this be done? Thanks! Sub MakeSupervisorBooks() Folder = "c:\temp\" 'sort worksheet by Managers LastRow = Range("C" & Rows.Count).End(xlUp).Row With ThisWorkbook.ActiveSheet .Rows("4:" & LastRow).Sort _ Key1:=.Range("C1"), _ Order1:=xlAscending, _ Header:=xlNo RowCount = 4 FirstRow = RowCount 'firstrow is the first row for each supervisor Do While .Range("C" & RowCount) < "" 'loop until all the rows are processed 'test when last row for supervisor is found If .Range("C" & RowCount) < .Range("C" & (RowCount + 1)) Then Supervisor = .Range("C" & RowCount) 'Open new Workbook Set NewBk = Workbooks.Add Set NewSht = NewBk.ActiveSheet NewSht.Name = Supervisor 'copy header row 3 to new workbook .Rows(3).Copy Destination:=NewSht.Rows(1) 'copy employee rows to new workbook .Rows(FirstRow & ":" & RowCount).Copy NewSht.Rows(2).PasteSpecial Paste:=xlPasteValues 'save new workbook NewBk.SaveAs Filename:=Folder & Supervisor & ".xls" NewBk.Close 'Set firstrow to first row of next supervisor FirstRow = RowCount + 1 End If RowCount = RowCount + 1 Loop End With End Sub |
|
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
macro filter
Try this as your loop - just add the new book once, then add sheet to it:
Set NewBk = Workbooks.Add Do While .Range("C" & RowCount) < "" 'loop until all the rows are processed 'test when last row for supervisor is found If .Range("C" & RowCount) < .Range("C" & (RowCount + 1)) Then Supervisor = .Range("C" & RowCount) 'Open new Workbook Set NewSht = NewBk.WorkSheets.Add NewSht.Name = Supervisor 'copy header row 3 to new workbook .Rows(3).Copy Destination:=NewSht.Rows(1) 'copy employee rows to new workbook .Rows(FirstRow & ":" & RowCount).Copy NewSht.Rows(2).PasteSpecial Paste:=xlPasteValues 'Set firstrow to first row of next supervisor FirstRow = RowCount + 1 End If RowCount = RowCount + 1 Loop 'Finally, save new workbook NewBk.SaveAs Filename:=Folder & Supervisor & ".xls" NewBk.Close HTH, Bernie MS Excel MVP "puiuluipui" wrote in message ... Hi, can this macro be modified to save results in another sheets in the same workbook? Now it's saving in many workbooks in "c:\temp\", but i need the results to be saved in sheets in the same workbook. Can this be done? Thanks! Sub MakeSupervisorBooks() Folder = "c:\temp\" 'sort worksheet by Managers LastRow = Range("C" & Rows.Count).End(xlUp).Row With ThisWorkbook.ActiveSheet .Rows("4:" & LastRow).Sort _ Key1:=.Range("C1"), _ Order1:=xlAscending, _ Header:=xlNo RowCount = 4 FirstRow = RowCount 'firstrow is the first row for each supervisor Do While .Range("C" & RowCount) < "" 'loop until all the rows are processed 'test when last row for supervisor is found If .Range("C" & RowCount) < .Range("C" & (RowCount + 1)) Then Supervisor = .Range("C" & RowCount) 'Open new Workbook Set NewBk = Workbooks.Add Set NewSht = NewBk.ActiveSheet NewSht.Name = Supervisor 'copy header row 3 to new workbook .Rows(3).Copy Destination:=NewSht.Rows(1) 'copy employee rows to new workbook .Rows(FirstRow & ":" & RowCount).Copy NewSht.Rows(2).PasteSpecial Paste:=xlPasteValues 'save new workbook NewBk.SaveAs Filename:=Folder & Supervisor & ".xls" NewBk.Close 'Set firstrow to first row of next supervisor FirstRow = RowCount + 1 End If RowCount = RowCount + 1 Loop End With End Sub |
|
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
macro filter
It's working!
Thanks allot! "Bernie Deitrick" a scris: Try this as your loop - just add the new book once, then add sheet to it: Set NewBk = Workbooks.Add Do While .Range("C" & RowCount) < "" 'loop until all the rows are processed 'test when last row for supervisor is found If .Range("C" & RowCount) < .Range("C" & (RowCount + 1)) Then Supervisor = .Range("C" & RowCount) 'Open new Workbook Set NewSht = NewBk.WorkSheets.Add NewSht.Name = Supervisor 'copy header row 3 to new workbook .Rows(3).Copy Destination:=NewSht.Rows(1) 'copy employee rows to new workbook .Rows(FirstRow & ":" & RowCount).Copy NewSht.Rows(2).PasteSpecial Paste:=xlPasteValues 'Set firstrow to first row of next supervisor FirstRow = RowCount + 1 End If RowCount = RowCount + 1 Loop 'Finally, save new workbook NewBk.SaveAs Filename:=Folder & Supervisor & ".xls" NewBk.Close HTH, Bernie MS Excel MVP "puiuluipui" wrote in message ... Hi, can this macro be modified to save results in another sheets in the same workbook? Now it's saving in many workbooks in "c:\temp\", but i need the results to be saved in sheets in the same workbook. Can this be done? Thanks! Sub MakeSupervisorBooks() Folder = "c:\temp\" 'sort worksheet by Managers LastRow = Range("C" & Rows.Count).End(xlUp).Row With ThisWorkbook.ActiveSheet .Rows("4:" & LastRow).Sort _ Key1:=.Range("C1"), _ Order1:=xlAscending, _ Header:=xlNo RowCount = 4 FirstRow = RowCount 'firstrow is the first row for each supervisor Do While .Range("C" & RowCount) < "" 'loop until all the rows are processed 'test when last row for supervisor is found If .Range("C" & RowCount) < .Range("C" & (RowCount + 1)) Then Supervisor = .Range("C" & RowCount) 'Open new Workbook Set NewBk = Workbooks.Add Set NewSht = NewBk.ActiveSheet NewSht.Name = Supervisor 'copy header row 3 to new workbook .Rows(3).Copy Destination:=NewSht.Rows(1) 'copy employee rows to new workbook .Rows(FirstRow & ":" & RowCount).Copy NewSht.Rows(2).PasteSpecial Paste:=xlPasteValues 'save new workbook NewBk.SaveAs Filename:=Folder & Supervisor & ".xls" NewBk.Close 'Set firstrow to first row of next supervisor FirstRow = RowCount + 1 End If RowCount = RowCount + 1 Loop End With End Sub |
|
#4
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
macro filter
Hi Bernie, can you help me with one more thing? I dont want this code to
create another xls. I have a workbook already with many sheets and i neet to run the code in sheet1 and the macro to copy rows to already created sheets. I need the code to do exactly like it's doing now but to copy rows from the workbook i am running the macro,to the same workbook and to copy to already created sheets. Criteria is in "C" column, so if in "C" the macro is finding "John", then to copy the row to "John" sheet, not to create a new sheet. I am running the code from sheet1 "workbook db" and i need the macro to save in all other sheets also in "workbook db". Can this be done? Thanks! "Bernie Deitrick" wrote: Try this as your loop - just add the new book once, then add sheet to it: Set NewBk = Workbooks.Add Do While .Range("C" & RowCount) < "" 'loop until all the rows are processed 'test when last row for supervisor is found If .Range("C" & RowCount) < .Range("C" & (RowCount + 1)) Then Supervisor = .Range("C" & RowCount) 'Open new Workbook Set NewSht = NewBk.WorkSheets.Add NewSht.Name = Supervisor 'copy header row 3 to new workbook .Rows(3).Copy Destination:=NewSht.Rows(1) 'copy employee rows to new workbook .Rows(FirstRow & ":" & RowCount).Copy NewSht.Rows(2).PasteSpecial Paste:=xlPasteValues 'Set firstrow to first row of next supervisor FirstRow = RowCount + 1 End If RowCount = RowCount + 1 Loop 'Finally, save new workbook NewBk.SaveAs Filename:=Folder & Supervisor & ".xls" NewBk.Close HTH, Bernie MS Excel MVP "puiuluipui" wrote in message ... Hi, can this macro be modified to save results in another sheets in the same workbook? Now it's saving in many workbooks in "c:\temp\", but i need the results to be saved in sheets in the same workbook. Can this be done? Thanks! Sub MakeSupervisorBooks() Folder = "c:\temp\" 'sort worksheet by Managers LastRow = Range("C" & Rows.Count).End(xlUp).Row With ThisWorkbook.ActiveSheet .Rows("4:" & LastRow).Sort _ Key1:=.Range("C1"), _ Order1:=xlAscending, _ Header:=xlNo RowCount = 4 FirstRow = RowCount 'firstrow is the first row for each supervisor Do While .Range("C" & RowCount) < "" 'loop until all the rows are processed 'test when last row for supervisor is found If .Range("C" & RowCount) < .Range("C" & (RowCount + 1)) Then Supervisor = .Range("C" & RowCount) 'Open new Workbook Set NewBk = Workbooks.Add Set NewSht = NewBk.ActiveSheet NewSht.Name = Supervisor 'copy header row 3 to new workbook .Rows(3).Copy Destination:=NewSht.Rows(1) 'copy employee rows to new workbook .Rows(FirstRow & ":" & RowCount).Copy NewSht.Rows(2).PasteSpecial Paste:=xlPasteValues 'save new workbook NewBk.SaveAs Filename:=Folder & Supervisor & ".xls" NewBk.Close 'Set firstrow to first row of next supervisor FirstRow = RowCount + 1 End If RowCount = RowCount + 1 Loop End With End Sub |
|
#5
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
macro filter
Don't use this line:
Set NewBk = Workbooks.Add Then try this, to add the new data at the bottom of the existing sheet: Do While .Range("C" & RowCount) < "" 'loop until all the rows are processed 'test when last row for supervisor is found If .Range("C" & RowCount) < .Range("C" & (RowCount + 1)) Then Supervisor = .Range("C" & RowCount) 'copy employee rows to new workbook .Rows(FirstRow & ":" & RowCount).Copy Worksheets(Supervisor).Cells(Rows.Count,1).End(xlU p). _ Offset(1,0).EntireRow.PasteSpecial Paste:=xlPasteValues 'Set firstrow to first row of next supervisor FirstRow = RowCount + 1 End If RowCount = RowCount + 1 Loop HTH, Bernie MS Excel MVP "puiuluipui" wrote in message ... Hi Bernie, can you help me with one more thing? I dont want this code to create another xls. I have a workbook already with many sheets and i neet to run the code in sheet1 and the macro to copy rows to already created sheets. I need the code to do exactly like it's doing now but to copy rows from the workbook i am running the macro,to the same workbook and to copy to already created sheets. Criteria is in "C" column, so if in "C" the macro is finding "John", then to copy the row to "John" sheet, not to create a new sheet. I am running the code from sheet1 "workbook db" and i need the macro to save in all other sheets also in "workbook db". Can this be done? Thanks! "Bernie Deitrick" wrote: Try this as your loop - just add the new book once, then add sheet to it: Set NewBk = Workbooks.Add Do While .Range("C" & RowCount) < "" 'loop until all the rows are processed 'test when last row for supervisor is found If .Range("C" & RowCount) < .Range("C" & (RowCount + 1)) Then Supervisor = .Range("C" & RowCount) 'Open new Workbook Set NewSht = NewBk.WorkSheets.Add NewSht.Name = Supervisor 'copy header row 3 to new workbook .Rows(3).Copy Destination:=NewSht.Rows(1) 'copy employee rows to new workbook .Rows(FirstRow & ":" & RowCount).Copy NewSht.Rows(2).PasteSpecial Paste:=xlPasteValues 'Set firstrow to first row of next supervisor FirstRow = RowCount + 1 End If RowCount = RowCount + 1 Loop 'Finally, save new workbook NewBk.SaveAs Filename:=Folder & Supervisor & ".xls" NewBk.Close HTH, Bernie MS Excel MVP "puiuluipui" wrote in message ... Hi, can this macro be modified to save results in another sheets in the same workbook? Now it's saving in many workbooks in "c:\temp\", but i need the results to be saved in sheets in the same workbook. Can this be done? Thanks! Sub MakeSupervisorBooks() Folder = "c:\temp\" 'sort worksheet by Managers LastRow = Range("C" & Rows.Count).End(xlUp).Row With ThisWorkbook.ActiveSheet .Rows("4:" & LastRow).Sort _ Key1:=.Range("C1"), _ Order1:=xlAscending, _ Header:=xlNo RowCount = 4 FirstRow = RowCount 'firstrow is the first row for each supervisor Do While .Range("C" & RowCount) < "" 'loop until all the rows are processed 'test when last row for supervisor is found If .Range("C" & RowCount) < .Range("C" & (RowCount + 1)) Then Supervisor = .Range("C" & RowCount) 'Open new Workbook Set NewBk = Workbooks.Add Set NewSht = NewBk.ActiveSheet NewSht.Name = Supervisor 'copy header row 3 to new workbook .Rows(3).Copy Destination:=NewSht.Rows(1) 'copy employee rows to new workbook .Rows(FirstRow & ":" & RowCount).Copy NewSht.Rows(2).PasteSpecial Paste:=xlPasteValues 'save new workbook NewBk.SaveAs Filename:=Folder & Supervisor & ".xls" NewBk.Close 'Set firstrow to first row of next supervisor FirstRow = RowCount + 1 End If RowCount = RowCount + 1 Loop End With End Sub |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Macro Filter | Excel Worksheet Functions | |||
| Macro - Date Filter | Excel Discussion (Misc queries) | |||
| how can this filter be done in a macro? | Excel Discussion (Misc queries) | |||
| Do i use a filter or a macro? | Excel Discussion (Misc queries) | |||
| Need a filter macro | Excel Discussion (Misc queries) | |||
Linear Mode
