Code not working

So far i have this code.
It is supposed to do this:

1. Go to a user defined sheet
2. search down a column finding a specific piece of text
3.when it finds the right cell. use the offset command to find pieces of data
4.copy and paste this data to another sheet
5. and add all accumulated data to the bottom of a table.
6. and then carry on searching through that column for more of the same criteria

Dim List As Object
Dim Cell1 As Object
Set List = Range((Range("MonthCHoice").Value) & 1)
Sheets(Range("MonthCHoice").Value).Select
For Each Cell1 In List
If Cell1 = Range("CourseName") Then
ActiveCell.Copy
Range("G7").Select
Selection.Copy
Sheets("Lists").Select
Range("Course45").Select
ActiveSheet.Paste
Sheets("January").Select
ActiveCell.Offset(0, 1).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Lists").Select
Range("Attendees45").Select
ActiveSheet.Paste
Sheets("January").Select
ActiveCell.Offset(0, -6).Range("A1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Lists").Select
Range("Date45").Select
ActiveSheet.Paste
Range("Row").Select
Selection.Copy
Range("Dummy").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Sheets(Range("MonthCHoice").Value).Select
End If
Next

The problems that i am having are that. It finds the first data okay. Then it copies it like i want it to. Then say i have five rows of the same criteria, it would create five rows onto the table, but use the same data for each, instead of using its own data. (also when there are four rows of the same criteria, four rows of the same data would be added). This is related to my earlier post, because the final table would be the range I want to name. Does anyone see any errors or anything wrong with the code. I have been trying to do this all day!

[waggy30]

It was me who posted this

[Barrie Davidson]

What is the address of the active cell on the sheet named "January"? Does this ever change?

[waggy30]

Thanks, I think you just found the problem. The active cell is meant to refer to the cell1 object. How would I refer to that?

[Barrie Davidson]

On 2002-03-09 12:23, waggy30 wrote:
Thanks, I think you just found the problem. The active cell is meant to refer to the cell1 object. How would I refer to that?

I hope you don't mind, but I made your code a little more efficient. One thing I have learned is: if you can eliminate "selecting" anything your code will be that much quicker.

Try this code (note, I did not test it so I'll bet you'll find something wrong. Difficult to test without data):

Dim List As Object

Set List = Range((Range("MonthCHoice").Value) & 1)

Sheets(Range("MonthCHoice").Value).Select

For Each c In List

    If c = Range("CourseName") Then

        Range("G7").Copy Destination:=Sheets("Lists").Range("Course45")

        Sheets("January").Select

        ActiveCell.Offset(0, 1).Copy _

            Destination:=Sheets("Lists").Range("Attendees45")

        ActiveCell.Offset(0, -6).Copy _

            Destination:=Sheets("Lists").Range("Date45")

        Range("Row").Copy _

            Destination:=Range("Dummy").End(xlDown).Offset(1, 0)

        Sheets(Range("MonthCHoice").Value).Select

    End If

Next c

The reason I was asking for what the active cell's address was in the sheet named "January", was to change the code so you didn't need to activate that sheet. If you can tell me how the cell is activated, maybe we can take out the step activating that sheet.

If you do encounter errors just let me know and we can tweak the code.

Regards,

[waggy30]

Once again thanks. I tweaked the code and it worked. The final code is

Dim List As Object
Dim c As Object
Set List = Range((Range("MonthCHoice").Value) & "1")
Sheets(Range("MonthCHoice").Value).Select
For Each c In List
If c = Range("CourseName") Then
c.Copy Destination:=Sheets("Lists").Range("Course45")
Sheets(Range("MonthCHoice").Value).Select
c.Offset(0, 2).Copy _
Destination:=Sheets("Lists").Range("Attendees45")
c.Offset(0, -5).Copy _
Destination:=Sheets("Lists").Range("Date45")
Sheets("Lists").Select
Range("Row").Copy _
Destination:=Range("Dummy").End(xlDown).Offset(1, 0)
Sheets(Range("MonthCHoice").Value).Select
End If
Next c
Sheets("Lists").Select
Range("F25", Range("H65536").End(xlUp).Address).Name = "RowSource"
CourseViewer.Show

Thanks again