Issue with matching fields script

Okay I will try and explain this simply then post my code . I have a work book with a large set of data with Company Name , Address , zip Columns the data in these rows can have duplicates *which we dont want to remove * and it can not be sorted again this is for clerical reasons. I have a script that takes a New work book and compares that work books Name Address and Zip columns against the columns in the first work book it then colors matching cells useing differnt colors depending on the column and then writes the ENTIRE row where a matching cell is found to a Results sheet in work book 1 * There is to much senstive data for me to post almost any of these work books if more explantion is needed let me know* Here is my issue things work almost 100% perfect the script pulls the sheet from workbook 2 in to work book 1 so as that work book one looks like this "Database sheet" "Results sheet" "Compare sheet *this sheet is from workbook 2 and is imported" matching cells are colored and there rows are written to the Results sheet EXCEPT for some reason my code skips any duplicate results as example we might have company IBM 10 DOG LANE twice it will skip writeing this out COMPLETELY so it wont write out IBM 10 DOG LANE at all in the results sheet it will skip it.

Just so its clear I dont want my code to care if there is duplicates it should write out the row if a match is found in any cell right now if there are duplicate matchs it completely ignores all the data , this does not mean if there is 3 copys of the same row it rights out one copy it currently doesnt right out ANY data that is duplicated.
Here is my code

Dim newsheet
Dim sh As Worksheet
Dim rA As Range, rB As Range, rA2 As Range, rB2 As Range, rA3 As Range, rB3 As Range
Dim cellA As Range, cellB As Range

'Copy function start
LastSheetName = "Results"
OutSheet = "OutputSheet"
OrgFileName = ActiveWorkbook.Name
NameWorkbook = "Database_Compare.xlsm"

Workbooks(OrgFileName).Activate
Workbooks(OrgFileName).Worksheets(1).Visible = True
Workbooks(OrgFileName).Sheets(1).Activate
Workbooks(OrgFileName).Sheets(1).Select
Workbooks(OrgFileName).Sheets(1).Copy After:=Workbooks(NameWorkbook).Sheets(LastSheetName)
Sheets(3).Name = "Compared"
'Copy Function End



Set sh = ActiveSheet
Set rA = Worksheets(1).Range("A2", Worksheets(1).Cells(Worksheets(1).Rows.Count, "A").End(xlUp))
Set rB = Worksheets(3).Range("A2", Worksheets(3).Cells(Worksheets(3).Rows.Count, "A").End(xlUp))
Set rA2 = Worksheets(1).Range("B2", Worksheets(1).Cells(Worksheets(1).Rows.Count, "B").End(xlUp))
Set rB2 = Worksheets(3).Range("B2", Worksheets(3).Cells(Worksheets(3).Rows.Count, "B").End(xlUp))
Set rA3 = Worksheets(1).Range("C2", Worksheets(1).Cells(Worksheets(1).Rows.Count, "C").End(xlUp))
Set rB3 = Worksheets(3).Range("C2", Worksheets(3).Cells(Worksheets(3).Rows.Count, "C").End(xlUp))
rA.Interior.ColorIndex = xlNone
rB.Interior.ColorIndex = xlNone

'0 - Black, 1 - Blue, 2 - Green, 3 - Cyan, 4 - Red, 5 - Magenta, 6 - Yellow/Brown, 7 - White, 8 - Gray,
'9 - Bright Blue, A - Bright Green, B - Bright Cyan, C - Bright Red, D - Bright Magenta, E - Bright Yellow, F - Bright White
'--------------------------------------------------------------------------------




'Start of Column One Check

For Each cellB In rB
 If Application.CountIf(rA, cellB) = 1 Then
   cellB.Interior.ColorIndex = 6 ' Colors cells
 End If
Next
For Each cellA In rA
 If Application.CountIf(rB, cellA) = 1 Then
    cellA.Interior.ColorIndex = 6 'Colors cells
 'This code copys cells that matched and pastes them in results sheet but it skips matchs entirely
    cellA.EntireRow.Copy
    Sheets(2).Range("A65536").End(xlUp).Offset(2, 0).PasteSpecial
 
 End If
Next

'End of Column One Check

'Start of Column Two Check

For Each cellB In rB2
    If Application.CountIf(rA2, cellB) = 1 Then
        cellB.Interior.ColorIndex = 3 'Colors cells
         
    End If
Next

For Each cellA In rA2
    If Application.CountIf(rB2, cellA) = 1 Then
        cellA.Interior.ColorIndex = 3 'Colors cells
        cellA.EntireRow.Copy
    Sheets(2).Range("A65536").End(xlUp).Offset(2, 0).PasteSpecial
    End If
Next


'End of Column Two Check

'Start of Column Three Check

For Each cellB In rB3
    If Application.CountIf(rA3, cellB) = 1 Then
        cellB.Interior.ColorIndex = 7 'Colors cells
    End If
Next

For Each cellA In rA3
    If Application.CountIf(rB3, cellA) = 1 Then
        cellA.Interior.ColorIndex = 7 'Colors cells
        cellA.EntireRow.Copy
    Sheets(2).Range("A65536").End(xlUp).Offset(2, 0).PasteSpecial
    End If
Next


'End of Column Three Check