Using Range Information

Hi

I hope someone can help, I have created some code that copies the currently selected sheet name to a sheet called 'Sheet3' where it forms a list starting in cell A1. This range increases whenever a sheet is selected that is not already in the list.

ie

Public Sub sheetChanged()
Dim Ws As Worksheet
Dim i As Integer
Set Ws = Worksheets("Sheet3")
If Trim(Ws.Cells(1, 1)) <> "" Then
If Not found(ActiveSheet.Name, i) Then
Ws.Cells(i, 1) = ActiveSheet.Name
End If
Else
Ws.Cells(1, 1) = ActiveSheet.Name
End If
End Sub

Function found(Val As String, i As Integer) As Boolean
found = False
Dim j
j = 1
While Trim(Worksheets("Sheet3").Cells(j, 1)) <> ""
If Worksheets("Sheet3").Cells(j, 1) = Val Then
found = True
Exit Function
End If
j = j + 1
Wend
i = j
End Function

At the momentI have setup a macro that currently copies data from one row to the first free row of the current sheet. However I then have to move to the next sheet and run the macro again. What I would like to do is automate this process so it looks at the list generated in the Sheet3 worksheet and runs the macro on all the sheet names within the list.

What code do I need to pass the information?, I currently have some test code underneath which works to a point, It will find the sheet names, but will not pass the information to the 'Worksheets(c).Select' line variable c always seems to remain empty yet on the code line above it registers it as Sheet2 for example, so it is looking down the list, it just seems not to work for the Worksheets(c).Select line

Sub Mange()

For Each c In Worksheets("sheet3").Range("Fifty")
If c = "" Then Exit Sub
Worksheets(c).Select
Rows("1:1").Select
Selection.Copy
Rows("3:3").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Next c
MsgBox "End"
End Sub