compare two ranges in different workbooks and copy data to a 3rd workbook

[asadalim1]

Hi
tryna get this peice of code to work but i encountered a RUN TIME ERROR 6 OVER FLOW :-O .

Here is how it goes:

I have two spreadsheets in different workbooks ( workbook 1: sheet 1 and workbook2: sheet1), here i need to compare column 5 in Book1 and Column 5 for all cells, say X is the value we are looking for..

X occurs once in book1 and might occur more than once in book2..so if a match occurs ( that is once the code checks that there is X occuring in both books in columns 5) it should copy all rows in book 2 where X occurs to a new workbook 3 in sheet 1 and also it shoud copy entire row data where X occurs in book 1 sheet 1

Sub wrkting()
Dim b1 As Workbook
Dim b2 As Workbook
Dim b3 As Workbook

Dim W1 As Worksheet
Dim W2 As Worksheet
Dim W3 As Worksheet

                    Set b1 = Workbooks("1")
                    Set b2 = Workbooks("1")
                    Set b3 = Workbooks("1")
                    Set W1 = b1.Worksheets("1")
                    Set W2 = b2.Worksheets("1")
                    Set W3 = b3.Worksheets("1")
Dim i3 As Long
Dim r  As Range
Dim r1 As Range
Dim r2 As Range
Dim c As Range
Dim N As Integer
Dim j1 As Integer
 _
Dim j3 As Integer
                    
                
    'j1 will be the number of columns copied from w1 to w3
     'j3 will be the column to start placing the copied data from w1 in w3
     'adjust as needed to fit your situation
    
    j1 = W1.Cells(2, 256).End(xlToLeft).Column
    j3 = W2.Cells(2, 256).End(xlToLeft).Column + 1
     
     'next 3 lines assume  headers to be skipped for column 5 processing
    W3.UsedRange.Offset(2, 0).Clear
    Set r1 = W1.Range("E3:E" & W1.Cells(65526, 5).End(xlUp).Row)
    Set r2 = W2.Range("E2:E" & W2.Cells(65526, 5).End(xlUp).Row)
    If W2.AutoFilterMode Then W2.Cells.AutoFilter
    i3 = 2
    For Each c In r1
        If Not IsEmpty(c) Then
            Set r = Nothing
            W2.Columns(5).AutoFilter 1, c.Value, xlOr, c.Value & "*"
            On Error Resume Next
            Set r = r2.SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
           
            If Not r Is Nothing Then
                i3 = i3 + 1
                N = r.Cells.Count - 1
                r.EntireRow.Copy W3.Cells(i3, 1)
                W1.Range(W1.Cells(c.Row, 1), W1.Cells(c.Row, j1)).Copy _
                W3.Range(W3.Cells(i3, j3), W3.Cells(i3 + N, j3 + j1 - 1))
                i3 = i3 + N
            End If
        End If
    Next c
    W2.Columns(5).AutoFilter
    Application.ScreenUpdating = True
    

End Sub