Create a New Worksheet and Copying Rows from Original Worksheet

This script is supposed to:

1. Scroll down Column B where the Depts are located.

2. Next, select the entire Row of Data from Col A to Col F

3. Create a New Worksheet with the name of the Dept in Col B

4. Paste that Entire Row that was selected in the newly created worksheet

5. And then, move on to the Next Row until the End of the Data on the Original Data Sheet

6. If the Dept value is different from that of the previous row in Col B, then a New Worksheet is created and the routine begins again on the next Worksheet.

I suck and it fails at the IF Then Statement. Does AnyOne have an Idea, so I can move forward from this.

For some reason, the code is broken at the IF Then Statement

Sub Breakout()
Dim FinalRow As Long, I As Long
Dim valuenewsheet As String
Dim Sht As Object

FinalRow = Range("A" & Rows.count).End(xlUp).Row
MsgBox (FinalRow)

ActiveSheet.Range("B1").Select 'selects value in B1
valuenewsheet = (ActiveCell.Value) 'sets value as variable

Sheets.Add.Name = valuenewsheet 'creates new sheet
Worksheets("Sheet1").Select 'reselects original sheet where data is

Set Sht = ThisWorkbook.Sheets("Sheet1") 'sets org data sheet as sht

For I = 1 To FinalRow Step 1 'initiates a loop
    Range(Sht.Cells(I, 6), Sht.Cells(I, 1).End(xlToLeft)).Select 'creates a range of data frm colA to colF one a single row
    Selection.Copy 'copies this data
    Sheets(valuenewsheet).Activate 'activates newly created sheet
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False 'pastes data frm slctd range
    ActiveCell.Offset(1, 0).Select 'while on new sheet, select next row
    Sht.Activate 'activate org. data sheet

        If Sht.Cells(I, 2) <> Sht.Cells(I - 1, 2) Then
        Sheets.Add.Name = Sht.Cells(I, 2).Value
        Worksheets(Sht).Select
        Else
        End If
Next I
End Sub