Help Please - VBA Macro- Copying rows to new file
 

Hi
I will appreciate any help.

I have this huge sheet, where I have the following columns:

A B C D E F G
Last name First Name Number Place Clinic Team Salesman



I need macro that will copy the rows (Including the headers row) of each
salesman to another file;call it by the name of the salesman (column G),
create a folder;call it by the name of the Team (Column F)
and save the file in that folder.

The file is sorted: first by Team and secondly by Salesman.
Salesman can be only in one team.

Thanks for your help.

Uziel

Help Please - VBA Macro- Copying rows to new file
 

What I would do is:

1) resort the original file by sales person (column G)
2) work down column G, each time the entry in column G changes, cop
that range of rows to a new file
3) sort the original file back the way it was in the beginning

Something like this:

Sub ExportBySalesPerson()

LastRow = Range("A1").End(xlDown).Row
Range("A1:G" & LastRow).Select
Selection.Sort Key1:=Range("G2"), Order1:=xlAscending
Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
_
DataOption1:=xlSortNormal

SalesRep = Range("G2")
FirstRow = 2
For myRow = 2 To LastRow + 1
If Cells(myRow, "G") < SalesRep Then
Workbooks.Add Name:=SalesRep
ThisWorkbook.Activate
Rows("1:1").Cop
Destination:=Workbooks(SalesRep).Range("A1")
Range(Cells(FirstRow, "A"), Cells(myRow - 1, "G")).Copy _
Destination = Workbooks(SalesRep).Range("A2")
Application.CutCopyMode = False
Workbooks(SalesRep).Save
Workbooks(SalesRep).Close
End If
Next myRow

End Su

--
Message posted from http://www.ExcelForum.com

Help Please - VBA Macro- Copying rows to new file
 

Thank you so much!


MSP77079 wrote in message ...
What I would do is:

1) resort the original file by sales person (column G)
2) work down column G, each time the entry in column G changes, copy
that range of rows to a new file
3) sort the original file back the way it was in the beginning

Something like this:

Sub ExportBySalesPerson()

LastRow = Range("A1").End(xlDown).Row
Range("A1:G" & LastRow).Select
Selection.Sort Key1:=Range("G2"), Order1:=xlAscending,
Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal

SalesRep = Range("G2")
FirstRow = 2
For myRow = 2 To LastRow + 1
If Cells(myRow, "G") < SalesRep Then
Workbooks.Add Name:=SalesRep
ThisWorkbook.Activate
Rows("1:1").Copy
Destination:=Workbooks(SalesRep).Range("A1")
Range(Cells(FirstRow, "A"), Cells(myRow - 1, "G")).Copy _
Destination = Workbooks(SalesRep).Range("A2")
Application.CutCopyMode = False
Workbooks(SalesRep).Save
Workbooks(SalesRep).Close
End If
Next myRow

End Sub


---
Message posted from http://www.ExcelForum.com/