Excel VBA NOT LOOPING

[simora]

I have a simple loop that is only capturing & Posting the first instance of the found value.
This code sits on a UserForm, but I have tried it in isolation also. It still refuses to loop.
Here's what I have. The workbooks are all unprotected.

Dim ccell As Range
Dim lastrow As Long

Application.ScreenUpdating = False   
      Sheets("Memo_Register").Activate
      lastrow = Sheets("Memo_Register").Range("A65536").End(xlUp).Row     ' or + 1
      Sheets("C_Register").Activate
     
For Each ccell In Sheets("C_Register").Range("E7:E" & Cells(Rows.Count, "E").End(xlUp).Row)
     If ccell.Value = "SERVICES" Then
             ccell.Resize(1, 2).Copy Destination:=Sheets("Memo_Register").Range("A" & lastrow).Offset(1, 0)
     End If
Next ccell
Application.ScreenUpdating = True

[p45cal]

You're always copying the data into the same place.
Directly after the line:

lastrow = Sheets("Memo_Register").Range("A65536").End(xlUp).Row

add the line:

Set Destn = Sheets("Memo_Register").Range("A" & lastrow).Offset(1, 0)

Change the line:

ccell.Resize(1, 2).Copy Destination:=Sheets("Memo_Register").Range("A" & lastrow).Offset(1, 0)

to:

ccell.Resize(1, 2).Copy Destn

then directly after this line add the line:

Set Destn = Destn.offset(1)

to move the location where the next copy will go.
All untested.

[simora]

Thanks p45cal
Will implement it tomorrow when I get a chance.
Again.
Thanks

[simora]

Thanks p45cal
I did implement it, and it works perfectly.

Thanks.