The code was creating a new workbook and then not putting anything in the new
workbook. I simply eliminated some lines by commenting them out. then
change the comments from new workbook to new worksheet.

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
' 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)
'Add new worksheet
Set NewSht = NewBk.Worksheets.Add
NewSht.Name = Supervisor
'copy header row 3 to new worksheet
.Rows(3).Copy Destination:=NewSht.Rows(1)
'copy employee rows to new worksheet
.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

End With
End Sub


"puiuluipui" wrote:

Hi i have a maco and i need to change it a little bit? 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 corresponding sheets also in "workbook db".

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

End With
End Sub


Can this be done?
Thanks!