I think this question has been asked before but after searching, I cannot find what I am looking for.
I have a workbook and column B contains a list of staff members. Using VB, I want to create a seperate workbook for each staff member. To start with I have sorted the sheet by staff name and managed to copy the first staff's data to a new sheet but am not sure about looping through the rest of the staff. Any help would be appreciated.
thanks
Matt
' sort data by staff name
Cells.Select
Selection.Sort Key1:=Range("AM2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("AM1").Select
lastrow = Sheets("test01").Range("A65536").End(xlUp).Row
Set myrange = Range("AM3:AM" & lastrow)
For Each cell In myrange
' determine row address where staff name changes
If cell.Value <> cell.Offset(-1, 0).Value Then
cell.Offset(-1, 0).Select
replastrow = ActiveCell.Row
' copy and paste selection into new book and save book
Range("A2:AY" & replastrow).Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.SaveAs "C:" & Range("AM2").Value & " " & Format(Date, "yyyymmdd") & ".xls"
Exit For
End If
Next
I have a workbook and column B contains a list of staff members. Using VB, I want to create a seperate workbook for each staff member. To start with I have sorted the sheet by staff name and managed to copy the first staff's data to a new sheet but am not sure about looping through the rest of the staff. Any help would be appreciated.
thanks
Matt
' sort data by staff name
Cells.Select
Selection.Sort Key1:=Range("AM2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("AM1").Select
lastrow = Sheets("test01").Range("A65536").End(xlUp).Row
Set myrange = Range("AM3:AM" & lastrow)
For Each cell In myrange
' determine row address where staff name changes
If cell.Value <> cell.Offset(-1, 0).Value Then
cell.Offset(-1, 0).Select
replastrow = ActiveCell.Row
' copy and paste selection into new book and save book
Range("A2:AY" & replastrow).Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.SaveAs "C:" & Range("AM2").Value & " " & Format(Date, "yyyymmdd") & ".xls"
Exit For
End If
Next