Try this:

Sub acsishere()
Dim i As Long
Dim ws As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set ws = ActiveSheet
ws.Copy Before:=Sheets(1)
ActiveSheet.Name = "Helper"
    Range(Cells(1, 3), Cells(ActiveSheet.UsedRange.Rows.count, ActiveSheet.UsedRange.Columns.count)).Select
    Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("C1") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlLeftToRight, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
On Error GoTo Z:
For i = 3 To ActiveSheet.Columns.count + 1
        If Cells(2, i).Text <> Cells(2, i + 1).Text Then
        ws.Range("A1:B" & ActiveSheet.UsedRange.Rows.count + 1).Copy
        Sheets.Add.Name = Cells(2, i).Value
        Range("A1").PasteSpecial xlPasteAll
        End If
        Sheets("Helper").Activate
Next i
Z:
Range("C2").Select
Do Until ActiveCell.Value = ""
    Range(ActiveCell.Offset(-1), ActiveCell.Offset(5)).Copy Sheets(ActiveCell.Value).Cells(1, Sheets(ActiveCell.Value).UsedRange.Columns.count + 1)
    Sheets("Helper").Activate
    ActiveCell.Offset(, 1).Select
Loop
ActiveSheet.Select
ActiveWindow.SelectedSheets.Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub