I have tinkered with this for a few days. I am getting the header row to copy and the first sales person (SP) as a secondary header. The problem is that the SP has more than one row of data. The number of rows is arbitrary; some have one, some have many, and in a lot of cases the SP is a blank cell. The macro executes and creates a separate workbook for the same sales person over and over until I break execution of the macro. Any thoughts most welcome.
Sub CreateWorkbooks()
Dim WBO As Workbook ' original workbook
Dim WBN As Workbook ' new workbook
Dim WSO As Worksheet ' original worksheet
Dim WSN As Worksheet ' new worksheet
Set WBO = ActiveWorkbook
Set WSO = ActiveSheet
finalrow = WSO.Cells(Rows.Count, 1).End(xlUp).Row + 1
LastSP = Cells(2, 53)
StartRow = 2
For i = 2 To finalrow
ThisSP = WSO.Cells(i, 1)
If ThisSP = LastSP Then
' do nothing
Else
' We have a new salesperson starting
' Copy all of the previous rows to a new workbook
LastRow = i - 1
RowCount = LastRow - StartRow + 1
' Create a new workbook.
Set WBN = Workbooks.Add(Template:=xlWBATWorksheet)
Set WSN = WBN.Worksheets(1)
' Set up the headings for the report
WSN.Cells(1, 1).Value = "Prospect List"
WSN.Cells(1, 1).Font.Size = 14
WSN.Cells(2, 1).Value = WSO.Cells(StartRow, 53)
WSO.Range("A1:BD1").Copy Destination:=WSN.Cells(4, 1)
' copy all of the records for this salesperson
WSO.Range(WSO.Cells(StartRow, 1), WSO.Cells(LastRow, 56)).Copy Destination:=WSN.Cells(5, 1)
FN = LastSP & ".xlsx"
FP = WBO.Path & Application.PathSeparator
WBN.SaveAs Filename:=FP & FN
WBN.Close SaveChanges:=False
LastSP = ThisSP
StartRow = i
End If
Next i
End Sub
Sub CreateWorkbooks()
Dim WBO As Workbook ' original workbook
Dim WBN As Workbook ' new workbook
Dim WSO As Worksheet ' original worksheet
Dim WSN As Worksheet ' new worksheet
Set WBO = ActiveWorkbook
Set WSO = ActiveSheet
finalrow = WSO.Cells(Rows.Count, 1).End(xlUp).Row + 1
LastSP = Cells(2, 53)
StartRow = 2
For i = 2 To finalrow
ThisSP = WSO.Cells(i, 1)
If ThisSP = LastSP Then
' do nothing
Else
' We have a new salesperson starting
' Copy all of the previous rows to a new workbook
LastRow = i - 1
RowCount = LastRow - StartRow + 1
' Create a new workbook.
Set WBN = Workbooks.Add(Template:=xlWBATWorksheet)
Set WSN = WBN.Worksheets(1)
' Set up the headings for the report
WSN.Cells(1, 1).Value = "Prospect List"
WSN.Cells(1, 1).Font.Size = 14
WSN.Cells(2, 1).Value = WSO.Cells(StartRow, 53)
WSO.Range("A1:BD1").Copy Destination:=WSN.Cells(4, 1)
' copy all of the records for this salesperson
WSO.Range(WSO.Cells(StartRow, 1), WSO.Cells(LastRow, 56)).Copy Destination:=WSN.Cells(5, 1)
FN = LastSP & ".xlsx"
FP = WBO.Path & Application.PathSeparator
WBN.SaveAs Filename:=FP & FN
WBN.Close SaveChanges:=False
LastSP = ThisSP
StartRow = i
End If
Next i
End Sub
