Sub CopyUniqueItems()
Dim Rng As Range, c As Long
Dim Rng2 As Range, i As Long
Dim LR1 As Integer, LR2 As Integer
Dim LR3 As Integer, LR4 As Integer
LR2 = Sheets("Sheet2").Cells(Rows.Count, "B").End(xlUp).Row
Application.ScreenUpdating = False
'List Unique Rows for Sheet1 by "X" in column G
For c = 1 To 6
Sheets("Sheet2").Select
Set Rng = Sheets("Sheet2").Range(Cells(2, c), Cells(LR2, c))
Sheets("Sheet1").Select
For i = 2 To Rng.Rows.Count
If Application.WorksheetFunction.CountIf(Rng, Cells(i, c)) = 0 Then
Cells(i, 7).Value = "X"
End If
Next i
Next c
'List Unique Rows for Sheet2 by "X" in column G
LR1 = Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row
For c = 1 To 6
Sheets("Sheet1").Select
Set Rng = Sheets("Sheet1").Range(Cells(2, c), Cells(LR1, c))
Sheets("Sheet2").Select
For i = 2 To Rng.Rows.Count
If Application.WorksheetFunction.CountIf(Rng, Cells(i, c)) = 0 Then
Cells(i, 7).Value = "X"
End If
Next i
Next c
'Exit Sub
'Copy rows that contain "X"'s in column G to Sheet3
Sheets("Sheet1").Select
Set Rng1 = Sheets("Sheet1").Range("C1", Range("C65536").End(xlUp))
For i = 1 To Rng1.Rows.Count
If Sheets("Sheet1").Cells(i, 7).Value = "X" Then
Sheets("Sheet1").Cells(i, 7).Value = ""
LR3 = Sheets("Sheet3").Cells(Rows.Count, "B").End(xlUp).Row + 1
Rows(i).EntireRow.Copy Destination:=Sheets("Sheet3").Range("A" & LR3)
End If
Next i
'Copy rows that contain "X"'s in column G to Sheet4
Sheets("Sheet2").Select
Set Rng1 = Sheets("Sheet2").Range("C1", Range("C65536").End(xlUp))
For i = 1 To Rng1.Rows.Count
If Sheets("Sheet2").Cells(i, 7).Value = "X" Then
Sheets("Sheet2").Cells(i, 7).Value = ""
LR4 = Sheets("Sheet4").Cells(Rows.Count, "B").End(xlUp).Row + 1
Rows(i).EntireRow.Copy Destination:=Sheets("Sheet4").Range("A" & LR4)
End If
Next i
Application.ScreenUpdating = True
End Sub