Sub createSheet()
    Dim x As Integer
    Dim uniqCnt As Integer
    Dim UniqOrg(1024) As String
    Dim People As New Scripting.Dictionary
    Dim SheetMain_Name As String
    Dim StartColumn As String
    Dim EndColumn As String
    Dim TableHeaderArea As String
    Dim PeopleCollection
    Dim TableLength As Integer
    Dim CopyRegion As String
    Dim TargetRegion As String
    Dim StartTow As Integer
    Dim CurrentRecordRow As Integer

    SheetMain_Name = "SheetMain"
    StartRow = 7 ' Start row of data
    StartColumn = "A"
    EndColumn = "W"
    TableHeaderArea = "A1:W6"
    TableLength = 1
    Application.Worksheets(1).Select
    NumRows = Range("T7", Range("T7").End(xlDown)).Rows.Count
    Range("T7").Select
    uniqCnt = 0

    For x = 1 To NumRows

        If Len(ActiveCell.Text) > 0 Then
            If InArray(UniqOrg, ActiveCell.Text) < 0 Then
                'ReDim Preserve UniqOrg(0 To (uniqCnt + 1)) As String
                UniqOrg(uniqCnt) = ActiveCell.Value

                Set MyPeopleCollection = New Collection
                MyPeopleCollection.Add ActiveCell.Row
                People.Add ActiveCell.Value, MyPeopleCollection
                uniqCnt = uniqCnt + 1
            Else
                People.Item(ActiveCell.Value).Add (ActiveCell.Row)
            End If

        End If
        ActiveCell.Offset(1, 0).Select

    Next x

    ' Create worksheets according to UniqOrg()
    For x = 0 To uniqCnt
        'Debug.Print "value=" + UniqOrg(x)
        If Len(UniqOrg(x)) > 0 Then
            'Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = UniqOrg(x)
            'Sheets(SheetMain_Name).Range(TableHeaderArea).Copy _
            '    Destination:=Sheets(UniqOrg(x)).Range(TableHeaderArea)
            TargetRow = StartRow
            For cnt = 1 To People.Item(UniqOrg(x)).Count
                CurrentRecordRow = People.Item(UniqOrg(x)).Item(cnt)
                CopyRegion = StartColumn + Trim(Str(CurrentRecordRow)) + ":" + EndColumn + Trim(Str(CurrentRecordRow))
                TargetRegion = StartColumn + Trim(Str(TargetRow)) + ":" + EndColumn + Trim(Str(TargetRow))
                TargetRow = TargetRow + 1
                'Debug.Print CopyRegion, "->", TargetRegion
                Sheets(SheetMain_Name).Range(CopyRegion).Copy _
                    Destination:=Sheets(UniqOrg(x)).Range(TargetRegion)
            Next cnt
        End If
    Next x

    ' Copy and Paste data into the worksheet.
    ' Remember to keep the state
End Sub

Function InArray(Arr, Search) As Long
    InArray = -1
    For x = LBound(Arr) To UBound(Arr)
        If Search = Arr(x) Then
            InArray = x
            Exit Function
        End If
    Next x
End Function