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