Thread: Insert full row from worksheer to another base on condition

Hey Ziyadh,

You can use this code -

Option Explicit
Dim lrow As Long
Dim strow As Long
Dim erow As Long
Dim i As Long

Sub compare_files()
Application.ScreenUpdating = False

Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "Temp"
lrow = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Sheet1").Range("A1:C" & lrow).Copy Worksheets("Temp").Range("A1")
Worksheets("Temp").Range("D1:D" & lrow).Value = "1"

lrow = Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Sheet2").Range("A1:C" & lrow).Copy Worksheets("Temp").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
strow = Worksheets("Temp").Range("D" & Rows.Count).End(xlUp).Row
erow = Worksheets("Temp").Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Temp").Range("D" & strow + 1 & ":D" & erow).Value = "2"

ActiveWorkbook.Worksheets("Temp").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Temp").Sort.SortFields.Add Key:=Range("A:A") _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Temp").Sort
    .SetRange Range("A:D")
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

With Worksheets("Temp")
    .Rows("1:1").Insert
    lrow = .Range("A" & Rows.Count).End(xlUp).Row
    For i = lrow To 2 Step -1
        If .Range("A" & i).Value = .Range("A" & i - 1).Value And .Range("B" & i).Value = .Range("B" & i - 1).Value And _
            .Range("C" & i).Value = .Range("C" & i - 1).Value And .Range("D" & i).Value <> .Range("D" & i + 1).Value Then
            .Rows(i & ":" & i).Delete
            lrow = lrow - 1
        ElseIf .Range("A" & i).Value = .Range("A" & i - 1).Value And .Range("B" & i).Value = .Range("B" & i - 1).Value And _
            .Range("C" & i).Value <> .Range("C" & i - 1).Value And .Range("D" & i).Value <> .Range("D" & i + 1).Value Then
            .Range("A" & i - 1 & ":C" & i).Interior.Color = 65535
        End If
    Next i
End With

Worksheets("Temp").Columns("D:D").Delete
Application.ScreenUpdating = True

End Sub