Slightly simplified version of previous post:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim wksThisSheet As Worksheet
Set wksThisSheet = ActiveSheet
Application.ScreenUpdating = False
If Not Intersect(Target, Range("C3:C382")) Is Nothing Then
If Not WorksheetExists(Range("C2").Text) Then _
Worksheets.Add(, Worksheets(Sheets.Count)).Name = _
Range("C2").Text
Intersect(Rows(Target.Row), Range("A:U")).Copy
Worksheets(Range("C2").Text).Rows(Target.Row)
ElseIf Not Intersect(Target, Range("F3:F382")) Is Nothing Then
If Not WorksheetExists(Range("F2").Text) Then _
Worksheets.Add(, Worksheets(Sheets.Count)).Name = _
Range("F2").Text
Intersect(Rows(Target.Row), Columns("A:U")).Copy
Worksheets(Range("F2").Text).Rows(Target.Row)
End If
wksThisSheet.Activate
Application.ScreenUpdating = True
End Sub

Private Function WorksheetExists(SheetName As String) As Boolean
Dim wks As Worksheet
WorksheetExists = False
For Each wks In Worksheets
If LCase(wks.Name) = LCase(SheetName) Then
WorksheetExists = True
Exit Function
End If
Next wks
End Function

"Bob Kilmer" wrote in message
...
Right-click the main sheet tab. Select View Code. Paste the following code
there. Test to see if you get the results you expect. You may want to use
a
duplicate copy of your workbook so as not to imperil real data.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim wks As Worksheet
Dim wksThisSheet As Worksheet
Set wksThisSheet = ActiveSheet
Application.ScreenUpdating = False
If Not Intersect(Target, Range("C3:C382")) Is Nothing Then
If Not WorksheetExists(Range("C2").Text) Then
Set wks = Worksheets.Add(, Worksheets(Sheets.Count))
wks.Name = Range("C2").Text
End If
Intersect(Rows(Target.Row), Range("A:U")).Copy
Worksheets(Range("C2").Text).Rows(Target.Row)
ElseIf Not Intersect(Target, Range("F3:F382")) Is Nothing Then
If Not WorksheetExists(Range("F2").Text) Then
Set wks = Worksheets.Add(, Worksheets(Sheets.Count))
wks.Name = Range("F2").Text
End If
Intersect(Rows(Target.Row), Columns("A:U")).Copy
Worksheets(Range("F2").Text).Rows(Target.Row)
End If
wksThisSheet.Activate
Application.ScreenUpdating = True
End Sub

Private Function WorksheetExists(SheetName As String) As Boolean
Dim wks As Worksheet
WorksheetExists = False
For Each wks In Worksheets
If LCase(wks.Name) = LCase(SheetName) Then
WorksheetExists = True
Exit Function
End If
Next wks
End Function



<Campbell wrote in message
...
I am a novice excel user but need help with a macro. I have a
spreadsheet with 21 columns A to U on sheet 1. I would like if
information is entered into column C or column F the row, Column A to
U would be copied to new sheet with name of the data found in either
column C or F. If the name sheet already rewrite to the named sheet.
The header row is A2 to U2
Data is in A3:U382
There will be a maximum of twenty different text values in the C and F
columns.