View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Campbell[_3_] Campbell[_3_] is offline
external usenet poster
 
Posts: 3
Default Create new sheets from data in either of two columns

On Sat, 14 Aug 2004 23:36:02 -0400, "Bob Kilmer"
wrote:

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 thanks for your macros ,but I am having a problem with where as
when I right click on the tab paste the macro I get a Macro dialogue
box asking a for a name to be entered.
When I try F8 to step through the code it will not permit me to do so.

Any ideas?