VBA Code- Move Records to different worksheets based on conditional logic

[BlueRhinos]

My objective is to parse out records in a single workbook into multiple workbooks based on certain field values for a particular record. As an example, let's assume I had records where a Line of Business field was equal to A,B,C, or D. The ideal code would take all records where Line of Business = A and move them to a separate worksheet (it would grab all fields for that record). It would then take all records where Line of Business = B and move them to a separate worksheet...and so on and so forth. Can VBA accomplish? If anyone can supply the code and I high level explanation of what it's doing, I'd really appreciate!

BlueRhinos

 

[VoG]

Take a look at Excel Explosion

 

[BlueRhinos]

thanks for pointing me to this resource...looks like just what I need. Unfortunately, I think I'm constrained by our network from installing...any VBA code you can provide me?

BR

 

[VoG]

Here's an example. It assumes that the rows that you want to split out into separate sheets are determined by what is in column A. You have to have the 'master' sheet selected when you run this and it sorts the data on that sheet .

Sub SalesmanToSheet()
Dim lastrow As Long, LastCol As Integer, i As Long, iStart As Long, iEnd As Long
Dim ws As Worksheet
Application.ScreenUpdating = False
With ActiveSheet
    lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
    LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
    .Range(.Cells(2, 1), Cells(lastrow, LastCol)).Sort Key1:=Range("A2"), Order1:=xlAscending, _
        Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    iStart = 2
    For i = 2 To lastrow
        If .Range("A" & i).Value <> .Range("A" & i + 1).Value Then
            iEnd = i
            Sheets.Add after:=Sheets(Sheets.Count)
            Set ws = ActiveSheet
            On Error Resume Next
            ws.Name = .Range("A" & iStart).Value
            On Error GoTo 0
            ws.Range(Cells(1, 1), Cells(1, LastCol)).Value = .Range(.Cells(1, 1), .Cells(1, LastCol)).Value
            With ws.Rows(1)
                .HorizontalAlignment = xlCenter
                With .Font
                    .ColorIndex = 5
                    .Bold = True
                End With
            End With
            .Range(.Cells(iStart, 1), .Cells(iEnd, LastCol)).Copy Destination:=ws.Range("A2")
            iStart = iEnd + 1
        End If
    Next i
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub