Copy and paste matching vaules to new workbook

[asadalim1]

Hi I have 2 workbooks. i want to compare the values in say Column 5 if there is a match in column five copy the values from column 5 into a new workbook. i am getting an subscript out of range error 9 any advice will be much appreciated.

Sub myown()
Dim B1, B2  As Workbook
Dim s1, s2  As Worksheet
Set B1 = Workbooks("b1")
Set B2 = Workbooks("b2")
Set s1 = B1.Worksheets("1")
Set s2 = B2.Worksheets("1")


Workbooks("B1.xls").Worksheets("s1").Activate Range("E1:E1")
Workbooks("B2.xls").Worksheets("s2").Activate Range("E1:E1")


If s1.Cells.column5 = s2.Cells.column5 Then
cell.Offset(0, 7).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
     :=False, Transpose:=False
     End If

ActiveWorkbook.Worksheets("Remake").Copy
 'the new workbook is now active
With ActiveWorkbook
    .Worksheets(1) = "Duty To Consider"
    .SaveAs "Duty To Consider" & Format(Date, "mmm yyyy") & ".xls"
End With
End Sub