P
puiuluipui
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
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