Exporting

I wouldn't hard code it that way. You're just asking for headaches tweaking the code.

Let's just add the name into the empty column A for each pasted row, then sort all the data. Doing this each time we add something will keep each person's items together without having to maintain separate "sections".

Option Explicit         'code checking on
Option Compare Text     'non-case-sensitive code

Private Sub Worksheet_Change(ByVal Target As Range)
'JBeaucaire  1/15/2010
'Transfer items marked "y" in column F to monthly sheets
'verify items have not been transferred previously

Dim cell As Range, rFind As Range, mSh As Worksheet
Dim cName As String, Val As String, NR As Long, r As Long

For Each cell In Target
    If cell.Column = 6 And cell.Value = "y" Then
        'Create sheet if necessary, get account name and row number
            r = cell.Row
            cName = Range("B" & r).Text
            Val = Cells(r, "A").End(xlUp).Text
            If Not Evaluate("ISREF(" & Val & "!A1)") Then
                Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = Val
                Me.Activate
                Set mSh = Sheets(Val)
                Range("A4:Q4").Copy
                mSh.Range("A1").PasteSpecial (xlPasteAll)
                mSh.Range("A1").PasteSpecial (xlPasteColumnWidths)
                mSh.Range("D:E,G:H").EntireColumn.Delete xlShiftToLeft
            Else
                Set mSh = Sheets(Val)
            End If
        
        'verify ACCOUNT/JOB NAME does not already exist on that sheet
        On Error Resume Next
        Set rFind = mSh.Range("B:B").Find(cName, After:=[B1], LookIn:=xlValues, LookAt:=xlWhole)
        On Error GoTo 0

        If rFind Is Nothing Then
            NR = mSh.Range("B" & Rows.Count).End(xlUp).Row + 1
        Else
            MsgBox "Item has been transferred already"
            Exit Sub
        End If
        
        Set rFind = Range("A" & r & ":C" & r & ",F" & r & ",I" & r & ":Q" & r)
        rFind.Copy mSh.Range("A" & NR)
        mSh.Range("A" & NR) = Me.Name
    Else
        Exit Sub
    End If
Next cell

With mSh.Range("A1").CurrentRegion
    .Sort Key1:=mSh.Range("A2"), Order1:=xlAscending, Key2:=mSh.Range("B2"), _
        Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
    .Borders.Weight = xlThin
End With

Beep
End Sub