Split Worksheet to Multiple Worksheets

[markoakes]

I have a worksheet that has data in columns A to N. The Salesman’s number is in column A and I need to split this first worksheet in to separate worksheets in the same workbook for each salesman.

 

[VoG]

Maybe this

Sub deviceNewSheet()
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, "U").End(xlUp).Row
    LastCol = .Cells(10, Columns.Count).End(xlToLeft).Column
    .Range(.Cells(10, 2), .Cells(LastRow, LastCol)).Sort Key1:=.Range("U10"), Order1:=xlAscending, _
        Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    iStart = 2
    For i = 2 To LastRow
        If .Range("U" & i).Value <> .Range("U" & i + 1).Value Then
            iEnd = i
            Sheets.Add after:=Sheets(Sheets.Count)
            Set ws = ActiveSheet
            On Error Resume Next
            ws.Name = .Range("U" & iStart).Value
            On Error GoTo 0
            .Range(.Cells(1, 1), .Cells(10, LastCol)).Copy Destination:=ws.Range("A1")
            With ws.Rows("1:10")
                .HorizontalAlignment = xlCenter
                With .Font
                    .ColorIndex = 5
                    .Bold = True
                End With
            End With
            .Range(.Cells(iStart, 1), .Cells(iEnd, LastCol)).Copy Destination:=ws.Range("A11")
            iStart = iEnd + 1
        End If
    Next i
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

 

[msnorbury]

VoG,
You are the greatest. It is still doing some funny things like the first new sheet made is the information from rows 5-8.
Second sheet is titled Location which is value for "U9" and a header, also gives first row of information.

All new sheets carry the first row values at the top which is valued as location "Boiler" and the new sheet for "RO/PROCESS WATER" still has a standard sheet name, will try to change values and see what happens. It is a far better thing then I could have ever come up with and you deserve as many kudos as can get for getting me this far. If you don't have any more time to spend on this I understand and will try to straighten out the glitches. Nice touch the blue "5" by the way.

I do appreciate all your help in this. I am learning but I can't even dim row column yet. Using if statements.