Trying to find duplicate, copy and paste certain unique values, and remove the duplicates

Hello, Thank you for your time and expertise in advance.
I have a workbook that uses a macro to aggregate attendance data from several other workbooks - the workbook is attached. I would like to use the email address column to search for duplicates, copy and paste attendance information, and then delete the duplicate row (and repeat this several times for each email address).

With the code I have come up, which may be considered beginner, I am getting this error:

1. Error comes up saying "Object required" (in the section highlighted)

I would really appreciate someone pointing me in the right direction (for me to change the code) or posting corrected code.

Sub CombineDuplicateRecords1()
Application.ScreenUpdating = False
'

Dim CurrentRow As Integer
Dim Email As String
Dim CheckColumn As Integer
Dim Q As Integer
Dim SearchRange As Range
Dim FindRow As Range
Dim RowofDuplicate As Integer


With ThisWorkbook.Sheets("Memberlist & Attend 2014-2015").Activate

    CurrentRow = 6
    Email = Range("C" & CurrentRow).Value
    CheckColumn = 5
    Q = 1
    
    
Do While Email <> ""
      
        Email = Range("C" & CurrentRow).Value
                            
       
            For Q = 1 To 5
             Set SearchRange = Sheets("Memberlist & Attend 2014-2015").Columns("C:C").Find(what:=Email, After:=.Range("C" & CurrentRow), LookIn:=xlFormulas, Lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
                If ActiveCell.Row = CurrentRow Then
                    Q = 6
                    Else
                    RowofDuplicate = ActiveCell.Row
                    ActiveSheet.Range(Cells(RowofDuplicate, 5), Cells(RowofDuplicate, 33)).Copy
                    ActiveSheet.Range(Cells(CurrentRow, 5), Cells(CurrentRow, 33)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True
                    ActiveSheet.Cells(RowofDuplicate, CheckColumn).EntireRow.Delete Shift:=xlUp
                End If
            Next Q

        CurrentRow = CurrentRow + 1
        Email = Range("C" & CurrentRow).Value
        Q = 1

Loop
End With
'
Application.ScreenUpdating = True
End Sub